1 subroutine caxpy(n,ca,cx,incx,cy,incy)
8 integer i,incx,incy,ix,iy,n
11 if (abs(
real(ca)) + abs(aimag(ca)) .eq. 0.0 ) return
12 if(incx.eq.1.and.incy.eq.1)
go to 20
19 if(incx.lt.0)ix = (-n+1)*incx + 1
20 if(incy.lt.0)iy = (-n+1)*incy + 1
22 cy(iy) = cy(iy) + ca*cx(ix)
31 cy(i) = cy(i) + ca*cx(i)
35 subroutine ccopy(n,cx,incx,cy,incy)
42 integer i,incx,incy,ix,iy,n
45 if(incx.eq.1.and.incy.eq.1)
go to 20
52 if(incx.lt.0)ix = (-n+1)*incx + 1
53 if(incy.lt.0)iy = (-n+1)*incy + 1
68 complex function cdotc(n,cx,incx,cy,incy)
75 complex cx(*),cy(*),ctemp
76 integer i,incx,incy,ix,iy,n
81 if(incx.eq.1.and.incy.eq.1)
go to 20
88 if(incx.lt.0)ix = (-n+1)*incx + 1
89 if(incy.lt.0)iy = (-n+1)*incy + 1
91 ctemp = ctemp + conjg(cx(ix))*cy(iy)
101 ctemp = ctemp + conjg(cx(i))*cy(i)
106 complex function cdotu(n,cx,incx,cy,incy)
112 complex cx(*),cy(*),ctemp
113 integer i,incx,incy,ix,iy,n
118 if(incx.eq.1.and.incy.eq.1)
go to 20
125 if(incx.lt.0)ix = (-n+1)*incx + 1
126 if(incy.lt.0)iy = (-n+1)*incy + 1
128 ctemp = ctemp + cx(ix)*cy(iy)
138 ctemp = ctemp + cx(i)*cy(i)
143 SUBROUTINE cgbmv ( TRANS, M, N, KL, KU, ALPHA, A, LDA, X, INCX,
147 INTEGER INCX, INCY, KL, KU, LDA, M, N
150 COMPLEX A( lda, * ), X( * ), Y( * )
275 parameter( one = ( 1.0e+0, 0.0e+0 ) )
277 parameter( zero = ( 0.0e+0, 0.0e+0 ) )
280 INTEGER I, INFO, IX, IY, J, JX, JY, K, KUP1, KX, KY,
289 INTRINSIC conjg, max, min
296 IF ( .NOT.lsame( trans,
'N' ).AND.
297 $ .NOT.lsame( trans,
'T' ).AND.
298 $ .NOT.lsame( trans,
'C' ) )
THEN 300 ELSE IF( m.LT.0 )
THEN 302 ELSE IF( n.LT.0 )
THEN 304 ELSE IF( kl.LT.0 )
THEN 306 ELSE IF( ku.LT.0 )
THEN 308 ELSE IF( lda.LT.( kl + ku + 1 ) )
THEN 310 ELSE IF( incx.EQ.0 )
THEN 312 ELSE IF( incy.EQ.0 )
THEN 316 CALL xerbla(
'CGBMV ', info )
322 IF( ( m.EQ.0 ).OR.( n.EQ.0 ).OR.
323 $ ( ( alpha.EQ.zero ).AND.( beta.EQ.one ) ) )
326 noconj = lsame( trans,
'T' )
331 IF( lsame( trans,
'N' ) )
THEN 341 kx = 1 - ( lenx - 1 )*incx
346 ky = 1 - ( leny - 1 )*incy
354 IF( beta.NE.one )
THEN 356 IF( beta.EQ.zero )
THEN 367 IF( beta.EQ.zero )
THEN 374 y( iy ) = beta*y( iy )
383 IF( lsame( trans,
'N' ) )
THEN 390 IF( x( jx ).NE.zero )
THEN 393 DO 50, i = max( 1, j - ku ), min( m, j + kl )
394 y( i ) = y( i ) + temp*a( k + i, j )
401 IF( x( jx ).NE.zero )
THEN 405 DO 70, i = max( 1, j - ku ), min( m, j + kl )
406 y( iy ) = y( iy ) + temp*a( k + i, j )
425 DO 90, i = max( 1, j - ku ), min( m, j + kl )
426 temp = temp + a( k + i, j )*x( i )
429 DO 100, i = max( 1, j - ku ), min( m, j + kl )
430 temp = temp + conjg( a( k + i, j ) )*x( i )
433 y( jy ) = y( jy ) + alpha*temp
442 DO 120, i = max( 1, j - ku ), min( m, j + kl )
443 temp = temp + a( k + i, j )*x( ix )
447 DO 130, i = max( 1, j - ku ), min( m, j + kl )
448 temp = temp + conjg( a( k + i, j ) )*x( ix )
452 y( jy ) = y( jy ) + alpha*temp
465 SUBROUTINE cgemm ( TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB,
468 CHARACTER*1 TRANSA, TRANSB
469 INTEGER M, N, K, LDA, LDB, LDC
472 COMPLEX A( lda, * ), B( ldb, * ), C( ldc, * )
603 LOGICAL CONJA, CONJB, NOTA, NOTB
604 INTEGER I, INFO, J, L, NCOLA, NROWA, NROWB
608 parameter( one = ( 1.0e+0, 0.0e+0 ) )
610 parameter( zero = ( 0.0e+0, 0.0e+0 ) )
620 nota = lsame( transa,
'N' )
621 notb = lsame( transb,
'N' )
622 conja = lsame( transa,
'C' )
623 conjb = lsame( transb,
'C' )
640 IF( ( .NOT.nota ).AND.
641 $ ( .NOT.conja ).AND.
642 $ ( .NOT.lsame( transa,
'T' ) ) )
THEN 644 ELSE IF( ( .NOT.notb ).AND.
645 $ ( .NOT.conjb ).AND.
646 $ ( .NOT.lsame( transb,
'T' ) ) )
THEN 648 ELSE IF( m .LT.0 )
THEN 650 ELSE IF( n .LT.0 )
THEN 652 ELSE IF( k .LT.0 )
THEN 654 ELSE IF( lda.LT.max( 1, nrowa ) )
THEN 656 ELSE IF( ldb.LT.max( 1, nrowb ) )
THEN 658 ELSE IF( ldc.LT.max( 1, m ) )
THEN 662 CALL xerbla(
'CGEMM ', info )
668 IF( ( m.EQ.0 ).OR.( n.EQ.0 ).OR.
669 $ ( ( ( alpha.EQ.zero ).OR.( k.EQ.0 ) ).AND.( beta.EQ.one ) ) )
674 IF( alpha.EQ.zero )
THEN 675 IF( beta.EQ.zero )
THEN 684 c( i, j ) = beta*c( i, j )
699 IF( beta.EQ.zero )
THEN 703 ELSE IF( beta.NE.one )
THEN 705 c( i, j ) = beta*c( i, j )
709 IF( b( l, j ).NE.zero )
THEN 710 temp = alpha*b( l, j )
712 c( i, j ) = c( i, j ) + temp*a( i, l )
725 temp = temp + conjg( a( l, i ) )*b( l, j )
727 IF( beta.EQ.zero )
THEN 728 c( i, j ) = alpha*temp
730 c( i, j ) = alpha*temp + beta*c( i, j )
742 temp = temp + a( l, i )*b( l, j )
744 IF( beta.EQ.zero )
THEN 745 c( i, j ) = alpha*temp
747 c( i, j ) = alpha*temp + beta*c( i, j )
758 IF( beta.EQ.zero )
THEN 762 ELSE IF( beta.NE.one )
THEN 764 c( i, j ) = beta*c( i, j )
768 IF( b( j, l ).NE.zero )
THEN 769 temp = alpha*conjg( b( j, l ) )
771 c( i, j ) = c( i, j ) + temp*a( i, l )
781 IF( beta.EQ.zero )
THEN 785 ELSE IF( beta.NE.one )
THEN 787 c( i, j ) = beta*c( i, j )
791 IF( b( j, l ).NE.zero )
THEN 792 temp = alpha*b( j, l )
794 c( i, j ) = c( i, j ) + temp*a( i, l )
809 temp = temp + conjg( a( l, i ) )*conjg( b( j, l ) )
811 IF( beta.EQ.zero )
THEN 812 c( i, j ) = alpha*temp
814 c( i, j ) = alpha*temp + beta*c( i, j )
826 temp = temp + conjg( a( l, i ) )*b( j, l )
828 IF( beta.EQ.zero )
THEN 829 c( i, j ) = alpha*temp
831 c( i, j ) = alpha*temp + beta*c( i, j )
845 temp = temp + a( l, i )*conjg( b( j, l ) )
847 IF( beta.EQ.zero )
THEN 848 c( i, j ) = alpha*temp
850 c( i, j ) = alpha*temp + beta*c( i, j )
862 temp = temp + a( l, i )*b( j, l )
864 IF( beta.EQ.zero )
THEN 865 c( i, j ) = alpha*temp
867 c( i, j ) = alpha*temp + beta*c( i, j )
879 SUBROUTINE cgemv ( TRANS, M, N, ALPHA, A, LDA, X, INCX,
883 INTEGER INCX, INCY, LDA, M, N
886 COMPLEX A( lda, * ), X( * ), Y( * )
984 parameter( one = ( 1.0e+0, 0.0e+0 ) )
986 parameter( zero = ( 0.0e+0, 0.0e+0 ) )
989 INTEGER I, INFO, IX, IY, J, JX, JY, KX, KY, LENX, LENY
1004 IF ( .NOT.lsame( trans,
'N' ).AND.
1005 $ .NOT.lsame( trans,
'T' ).AND.
1006 $ .NOT.lsame( trans,
'C' ) )
THEN 1008 ELSE IF( m.LT.0 )
THEN 1010 ELSE IF( n.LT.0 )
THEN 1012 ELSE IF( lda.LT.max( 1, m ) )
THEN 1014 ELSE IF( incx.EQ.0 )
THEN 1016 ELSE IF( incy.EQ.0 )
THEN 1020 CALL xerbla(
'CGEMV ', info )
1026 IF( ( m.EQ.0 ).OR.( n.EQ.0 ).OR.
1027 $ ( ( alpha.EQ.zero ).AND.( beta.EQ.one ) ) )
1030 noconj = lsame( trans,
'T' )
1035 IF( lsame( trans,
'N' ) )
THEN 1045 kx = 1 - ( lenx - 1 )*incx
1050 ky = 1 - ( leny - 1 )*incy
1058 IF( beta.NE.one )
THEN 1060 IF( beta.EQ.zero )
THEN 1066 y( i ) = beta*y( i )
1071 IF( beta.EQ.zero )
THEN 1078 y( iy ) = beta*y( iy )
1086 IF( lsame( trans,
'N' ) )
THEN 1093 IF( x( jx ).NE.zero )
THEN 1094 temp = alpha*x( jx )
1096 y( i ) = y( i ) + temp*a( i, j )
1103 IF( x( jx ).NE.zero )
THEN 1104 temp = alpha*x( jx )
1107 y( iy ) = y( iy ) + temp*a( i, j )
1124 temp = temp + a( i, j )*x( i )
1128 temp = temp + conjg( a( i, j ) )*x( i )
1131 y( jy ) = y( jy ) + alpha*temp
1140 temp = temp + a( i, j )*x( ix )
1145 temp = temp + conjg( a( i, j ) )*x( ix )
1149 y( jy ) = y( jy ) + alpha*temp
1160 SUBROUTINE cgerc ( M, N, ALPHA, X, INCX, Y, INCY, A, LDA )
1163 INTEGER INCX, INCY, LDA, M, N
1165 COMPLEX A( lda, * ), X( * ), Y( * )
1240 parameter( zero = ( 0.0e+0, 0.0e+0 ) )
1243 INTEGER I, INFO, IX, J, JY, KX
1247 INTRINSIC conjg, max
1256 ELSE IF( n.LT.0 )
THEN 1258 ELSE IF( incx.EQ.0 )
THEN 1260 ELSE IF( incy.EQ.0 )
THEN 1262 ELSE IF( lda.LT.max( 1, m ) )
THEN 1266 CALL xerbla(
'CGERC ', info )
1272 IF( ( m.EQ.0 ).OR.( n.EQ.0 ).OR.( alpha.EQ.zero ) )
1281 jy = 1 - ( n - 1 )*incy
1285 IF( y( jy ).NE.zero )
THEN 1286 temp = alpha*conjg( y( jy ) )
1288 a( i, j ) = a( i, j ) + x( i )*temp
1297 kx = 1 - ( m - 1 )*incx
1300 IF( y( jy ).NE.zero )
THEN 1301 temp = alpha*conjg( y( jy ) )
1304 a( i, j ) = a( i, j ) + x( ix )*temp
1317 SUBROUTINE cgeru ( M, N, ALPHA, X, INCX, Y, INCY, A, LDA )
1320 INTEGER INCX, INCY, LDA, M, N
1322 COMPLEX A( lda, * ), X( * ), Y( * )
1397 parameter( zero = ( 0.0e+0, 0.0e+0 ) )
1400 INTEGER I, INFO, IX, J, JY, KX
1413 ELSE IF( n.LT.0 )
THEN 1415 ELSE IF( incx.EQ.0 )
THEN 1417 ELSE IF( incy.EQ.0 )
THEN 1419 ELSE IF( lda.LT.max( 1, m ) )
THEN 1423 CALL xerbla(
'CGERU ', info )
1429 IF( ( m.EQ.0 ).OR.( n.EQ.0 ).OR.( alpha.EQ.zero ) )
1438 jy = 1 - ( n - 1 )*incy
1442 IF( y( jy ).NE.zero )
THEN 1443 temp = alpha*y( jy )
1445 a( i, j ) = a( i, j ) + x( i )*temp
1454 kx = 1 - ( m - 1 )*incx
1457 IF( y( jy ).NE.zero )
THEN 1458 temp = alpha*y( jy )
1461 a( i, j ) = a( i, j ) + x( ix )*temp
1474 SUBROUTINE chbmv ( UPLO, N, K, ALPHA, A, LDA, X, INCX,
1478 INTEGER INCX, INCY, K, LDA, N
1481 COMPLEX A( lda, * ), X( * ), Y( * )
1608 parameter( one = ( 1.0e+0, 0.0e+0 ) )
1610 parameter( zero = ( 0.0e+0, 0.0e+0 ) )
1612 COMPLEX TEMP1, TEMP2
1613 INTEGER I, INFO, IX, IY, J, JX, JY, KPLUS1, KX, KY, L
1620 INTRINSIC conjg, max, min,
real 1627 IF ( .NOT.lsame( uplo,
'U' ).AND.
1628 $ .NOT.lsame( uplo,
'L' ) )
THEN 1630 ELSE IF( n.LT.0 )
THEN 1632 ELSE IF( k.LT.0 )
THEN 1634 ELSE IF( lda.LT.( k + 1 ) )
THEN 1636 ELSE IF( incx.EQ.0 )
THEN 1638 ELSE IF( incy.EQ.0 )
THEN 1642 CALL xerbla(
'CHBMV ', info )
1648 IF( ( n.EQ.0 ).OR.( ( alpha.EQ.zero ).AND.( beta.EQ.one ) ) )
1656 kx = 1 - ( n - 1 )*incx
1661 ky = 1 - ( n - 1 )*incy
1669 IF( beta.NE.one )
THEN 1671 IF( beta.EQ.zero )
THEN 1677 y( i ) = beta*y( i )
1682 IF( beta.EQ.zero )
THEN 1689 y( iy ) = beta*y( iy )
1697 IF( lsame( uplo,
'U' ) )
THEN 1702 IF( ( incx.EQ.1 ).AND.( incy.EQ.1 ) )
THEN 1704 temp1 = alpha*x( j )
1707 DO 50, i = max( 1, j - k ), j - 1
1708 y( i ) = y( i ) + temp1*a( l + i, j )
1709 temp2 = temp2 + conjg( a( l + i, j ) )*x( i )
1711 y( j ) = y( j ) + temp1*
REAL( A( KPLUS1, J ) )
1718 temp1 = alpha*x( jx )
1723 DO 70, i = max( 1, j - k ), j - 1
1724 y( iy ) = y( iy ) + temp1*a( l + i, j )
1725 temp2 = temp2 + conjg( a( l + i, j ) )*x( ix )
1729 y( jy ) = y( jy ) + temp1*
REAL( A( KPLUS1, J ) )
1743 IF( ( incx.EQ.1 ).AND.( incy.EQ.1 ) )
THEN 1745 temp1 = alpha*x( j )
1747 y( j ) = y( j ) + temp1*
REAL( A( 1, J ) )
1749 DO 90, i = j + 1, min( n, j + k )
1750 y( i ) = y( i ) + temp1*a( l + i, j )
1751 temp2 = temp2 + conjg( a( l + i, j ) )*x( i )
1753 y( j ) = y( j ) + alpha*temp2
1759 temp1 = alpha*x( jx )
1761 y( jy ) = y( jy ) + temp1*
REAL( A( 1, J ) )
1765 DO 110, i = j + 1, min( n, j + k )
1768 y( iy ) = y( iy ) + temp1*a( l + i, j )
1769 temp2 = temp2 + conjg( a( l + i, j ) )*x( ix )
1771 y( jy ) = y( jy ) + alpha*temp2
1783 SUBROUTINE chemm ( SIDE, UPLO, M, N, ALPHA, A, LDA, B, LDB,
1786 CHARACTER*1 SIDE, UPLO
1787 INTEGER M, N, LDA, LDB, LDC
1790 COMPLEX A( lda, * ), B( ldb, * ), C( ldc, * )
1925 INTRINSIC conjg, max,
real 1928 INTEGER I, INFO, J, K, NROWA
1929 COMPLEX TEMP1, TEMP2
1932 parameter( one = ( 1.0e+0, 0.0e+0 ) )
1934 parameter( zero = ( 0.0e+0, 0.0e+0 ) )
1940 IF( lsame( side,
'L' ) )
THEN 1945 upper = lsame( uplo,
'U' )
1950 IF( ( .NOT.lsame( side,
'L' ) ).AND.
1951 $ ( .NOT.lsame( side,
'R' ) ) )
THEN 1953 ELSE IF( ( .NOT.upper ).AND.
1954 $ ( .NOT.lsame( uplo,
'L' ) ) )
THEN 1956 ELSE IF( m .LT.0 )
THEN 1958 ELSE IF( n .LT.0 )
THEN 1960 ELSE IF( lda.LT.max( 1, nrowa ) )
THEN 1962 ELSE IF( ldb.LT.max( 1, m ) )
THEN 1964 ELSE IF( ldc.LT.max( 1, m ) )
THEN 1968 CALL xerbla(
'CHEMM ', info )
1974 IF( ( m.EQ.0 ).OR.( n.EQ.0 ).OR.
1975 $ ( ( alpha.EQ.zero ).AND.( beta.EQ.one ) ) )
1980 IF( alpha.EQ.zero )
THEN 1981 IF( beta.EQ.zero )
THEN 1990 c( i, j ) = beta*c( i, j )
1999 IF( lsame( side,
'L' ) )
THEN 2006 temp1 = alpha*b( i, j )
2009 c( k, j ) = c( k, j ) + temp1*a( k, i )
2011 $ b( k, j )*conjg( a( k, i ) )
2013 IF( beta.EQ.zero )
THEN 2014 c( i, j ) = temp1*
REAL( A( I, I ) ) +
2017 c( i, j ) = beta *c( i, j ) +
2018 $ temp1*
REAL( A( I, I ) ) +
2026 temp1 = alpha*b( i, j )
2029 c( k, j ) = c( k, j ) + temp1*a( k, i )
2031 $ b( k, j )*conjg( a( k, i ) )
2033 IF( beta.EQ.zero )
THEN 2034 c( i, j ) = temp1*
REAL( A( I, I ) ) +
2037 c( i, j ) = beta *c( i, j ) +
2038 $ temp1*
REAL( A( I, I ) ) +
2049 temp1 = alpha*
REAL( A( J, J ) )
2050 IF( beta.EQ.zero )
THEN 2052 c( i, j ) = temp1*b( i, j )
2056 c( i, j ) = beta*c( i, j ) + temp1*b( i, j )
2059 DO 140, k = 1, j - 1
2061 temp1 = alpha*a( k, j )
2063 temp1 = alpha*conjg( a( j, k ) )
2066 c( i, j ) = c( i, j ) + temp1*b( i, k )
2069 DO 160, k = j + 1, n
2071 temp1 = alpha*conjg( a( j, k ) )
2073 temp1 = alpha*a( k, j )
2076 c( i, j ) = c( i, j ) + temp1*b( i, k )
2087 SUBROUTINE chemv ( UPLO, N, ALPHA, A, LDA, X, INCX,
2091 INTEGER INCX, INCY, LDA, N
2094 COMPLEX A( lda, * ), X( * ), Y( * )
2190 parameter( one = ( 1.0e+0, 0.0e+0 ) )
2192 parameter( zero = ( 0.0e+0, 0.0e+0 ) )
2194 COMPLEX TEMP1, TEMP2
2195 INTEGER I, INFO, IX, IY, J, JX, JY, KX, KY
2202 INTRINSIC conjg, max,
real 2209 IF ( .NOT.lsame( uplo,
'U' ).AND.
2210 $ .NOT.lsame( uplo,
'L' ) )
THEN 2212 ELSE IF( n.LT.0 )
THEN 2214 ELSE IF( lda.LT.max( 1, n ) )
THEN 2216 ELSE IF( incx.EQ.0 )
THEN 2218 ELSE IF( incy.EQ.0 )
THEN 2222 CALL xerbla(
'CHEMV ', info )
2228 IF( ( n.EQ.0 ).OR.( ( alpha.EQ.zero ).AND.( beta.EQ.one ) ) )
2236 kx = 1 - ( n - 1 )*incx
2241 ky = 1 - ( n - 1 )*incy
2250 IF( beta.NE.one )
THEN 2252 IF( beta.EQ.zero )
THEN 2258 y( i ) = beta*y( i )
2263 IF( beta.EQ.zero )
THEN 2270 y( iy ) = beta*y( iy )
2278 IF( lsame( uplo,
'U' ) )
THEN 2282 IF( ( incx.EQ.1 ).AND.( incy.EQ.1 ) )
THEN 2284 temp1 = alpha*x( j )
2287 y( i ) = y( i ) + temp1*a( i, j )
2288 temp2 = temp2 + conjg( a( i, j ) )*x( i )
2290 y( j ) = y( j ) + temp1*
REAL( A( J, J ) ) + ALPHA*TEMP2
2296 temp1 = alpha*x( jx )
2301 y( iy ) = y( iy ) + temp1*a( i, j )
2302 temp2 = temp2 + conjg( a( i, j ) )*x( ix )
2306 y( jy ) = y( jy ) + temp1*
REAL( A( J, J ) ) + ALPHA*TEMP2
2315 IF( ( incx.EQ.1 ).AND.( incy.EQ.1 ) )
THEN 2317 temp1 = alpha*x( j )
2319 y( j ) = y( j ) + temp1*
REAL( A( J, J ) )
2321 y( i ) = y( i ) + temp1*a( i, j )
2322 temp2 = temp2 + conjg( a( i, j ) )*x( i )
2324 y( j ) = y( j ) + alpha*temp2
2330 temp1 = alpha*x( jx )
2332 y( jy ) = y( jy ) + temp1*
REAL( A( J, J ) )
2335 DO 110, i = j + 1, n
2338 y( iy ) = y( iy ) + temp1*a( i, j )
2339 temp2 = temp2 + conjg( a( i, j ) )*x( ix )
2341 y( jy ) = y( jy ) + alpha*temp2
2353 SUBROUTINE cher2 ( UPLO, N, ALPHA, X, INCX, Y, INCY, A, LDA )
2356 INTEGER INCX, INCY, LDA, N
2359 COMPLEX A( lda, * ), X( * ), Y( * )
2454 parameter( zero = ( 0.0e+0, 0.0e+0 ) )
2456 COMPLEX TEMP1, TEMP2
2457 INTEGER I, INFO, IX, IY, J, JX, JY, KX, KY
2464 INTRINSIC conjg, max,
real 2471 IF ( .NOT.lsame( uplo,
'U' ).AND.
2472 $ .NOT.lsame( uplo,
'L' ) )
THEN 2474 ELSE IF( n.LT.0 )
THEN 2476 ELSE IF( incx.EQ.0 )
THEN 2478 ELSE IF( incy.EQ.0 )
THEN 2480 ELSE IF( lda.LT.max( 1, n ) )
THEN 2484 CALL xerbla(
'CHER2 ', info )
2490 IF( ( n.EQ.0 ).OR.( alpha.EQ.zero ) )
2496 IF( ( incx.NE.1 ).OR.( incy.NE.1 ) )
THEN 2500 kx = 1 - ( n - 1 )*incx
2505 ky = 1 - ( n - 1 )*incy
2515 IF( lsame( uplo,
'U' ) )
THEN 2519 IF( ( incx.EQ.1 ).AND.( incy.EQ.1 ) )
THEN 2521 IF( ( x( j ).NE.zero ).OR.( y( j ).NE.zero ) )
THEN 2522 temp1 = alpha*conjg( y( j ) )
2523 temp2 = conjg( alpha*x( j ) )
2525 a( i, j ) = a( i, j ) + x( i )*temp1 + y( i )*temp2
2527 a( j, j ) =
REAL( A( J, J ) ) +
2528 $
REAL( x( j )*temp1 + y( j )*temp2 )
2530 a( j, j ) =
REAL( A( J, J ) )
2535 IF( ( x( jx ).NE.zero ).OR.( y( jy ).NE.zero ) )
THEN 2536 temp1 = alpha*conjg( y( jy ) )
2537 temp2 = conjg( alpha*x( jx ) )
2541 a( i, j ) = a( i, j ) + x( ix )*temp1
2546 a( j, j ) =
REAL( A( J, J ) ) +
2547 $
REAL( x( jx )*temp1 + y( jy )*temp2 )
2549 a( j, j ) =
REAL( A( J, J ) )
2559 IF( ( incx.EQ.1 ).AND.( incy.EQ.1 ) )
THEN 2561 IF( ( x( j ).NE.zero ).OR.( y( j ).NE.zero ) )
THEN 2562 temp1 = alpha*conjg( y( j ) )
2563 temp2 = conjg( alpha*x( j ) )
2564 a( j, j ) =
REAL( A( J, J ) ) +
2565 $
REAL( x( j )*temp1 + y( j )*temp2 )
2567 a( i, j ) = a( i, j ) + x( i )*temp1 + y( i )*temp2
2570 a( j, j ) =
REAL( A( J, J ) )
2575 IF( ( x( jx ).NE.zero ).OR.( y( jy ).NE.zero ) )
THEN 2576 temp1 = alpha*conjg( y( jy ) )
2577 temp2 = conjg( alpha*x( jx ) )
2578 a( j, j ) =
REAL( A( J, J ) ) +
2579 $
REAL( x( jx )*temp1 + y( jy )*temp2 )
2585 a( i, j ) = a( i, j ) + x( ix )*temp1
2589 a( j, j ) =
REAL( A( J, J ) )
2602 SUBROUTINE cher2k( UPLO, TRANS, N, K, ALPHA, A, LDA, B, LDB,
2605 CHARACTER*1 UPLO, TRANS
2606 INTEGER N, K, LDA, LDB, LDC
2610 COMPLEX A( lda, * ), B( ldb, * ), C( ldc, * )
2750 INTRINSIC conjg, max,
real 2753 INTEGER I, INFO, J, L, NROWA
2754 COMPLEX TEMP1, TEMP2
2757 parameter( one = 1.0e+0 )
2759 parameter( zero = ( 0.0e+0, 0.0e+0 ) )
2765 IF( lsame( trans,
'N' ) )
THEN 2770 upper = lsame( uplo,
'U' )
2773 IF( ( .NOT.upper ).AND.
2774 $ ( .NOT.lsame( uplo ,
'L' ) ) )
THEN 2776 ELSE IF( ( .NOT.lsame( trans,
'N' ) ).AND.
2777 $ ( .NOT.lsame( trans,
'C' ) ) )
THEN 2779 ELSE IF( n .LT.0 )
THEN 2781 ELSE IF( k .LT.0 )
THEN 2783 ELSE IF( lda.LT.max( 1, nrowa ) )
THEN 2785 ELSE IF( ldb.LT.max( 1, nrowa ) )
THEN 2787 ELSE IF( ldc.LT.max( 1, n ) )
THEN 2791 CALL xerbla(
'CHER2K', info )
2798 $ ( ( ( alpha.EQ.zero ).OR.( k.EQ.0 ) ).AND.( beta.EQ.one ) ) )
2803 IF( alpha.EQ.zero )
THEN 2805 IF( beta.EQ.
REAL( ZERO ) )then
2814 c( i, j ) = beta*c( i, j )
2816 c( j, j ) = beta*
REAL( C( J, J ) )
2820 IF( beta.EQ.
REAL( ZERO ) )then
2828 c( j, j ) = beta*
REAL( C( J, J ) )
2830 c( i, j ) = beta*c( i, j )
2840 IF( lsame( trans,
'N' ) )
THEN 2847 IF( beta.EQ.
REAL( ZERO ) )then
2851 ELSE IF( beta.NE.one )
THEN 2852 DO 100, i = 1, j - 1
2853 c( i, j ) = beta*c( i, j )
2855 c( j, j ) = beta*
REAL( C( J, J ) )
2857 c( j, j ) =
REAL( C( J, J ) )
2860 IF( ( a( j, l ).NE.zero ).OR.
2861 $ ( b( j, l ).NE.zero ) )
THEN 2862 temp1 = alpha*conjg( b( j, l ) )
2863 temp2 = conjg( alpha*a( j, l ) )
2864 DO 110, i = 1, j - 1
2865 c( i, j ) = c( i, j ) + a( i, l )*temp1 +
2868 c( j, j ) =
REAL( C( J, J ) ) +
2869 $
REAL( a( j, l )*temp1 +
2876 IF( beta.EQ.
REAL( ZERO ) )then
2880 ELSE IF( beta.NE.one )
THEN 2881 DO 150, i = j + 1, n
2882 c( i, j ) = beta*c( i, j )
2884 c( j, j ) = beta*
REAL( C( J, J ) )
2886 c( j, j ) =
REAL( C( J, J ) )
2889 IF( ( a( j, l ).NE.zero ).OR.
2890 $ ( b( j, l ).NE.zero ) )
THEN 2891 temp1 = alpha*conjg( b( j, l ) )
2892 temp2 = conjg( alpha*a( j, l ) )
2893 DO 160, i = j + 1, n
2894 c( i, j ) = c( i, j ) + a( i, l )*temp1 +
2897 c( j, j ) =
REAL( C( J, J ) ) +
2898 $
REAL( a( j, l )*temp1 +
2915 temp1 = temp1 + conjg( a( l, i ) )*b( l, j )
2916 temp2 = temp2 + conjg( b( l, i ) )*a( l, j )
2919 IF( beta.EQ.
REAL( ZERO ) )then
2920 c( j, j ) =
REAL( alpha *temp1 +
2921 $ conjg( alpha )*temp2 )
2923 c( j, j ) = beta*
REAL( C( J, J ) ) +
2924 $
REAL( alpha *temp1 +
2925 $ conjg( alpha )*temp2 )
2928 IF( beta.EQ.
REAL( ZERO ) )then
2929 c( i, j ) = alpha*temp1 + conjg( alpha )*temp2
2931 c( i, j ) = beta *c( i, j ) +
2932 $ alpha*temp1 + conjg( alpha )*temp2
2943 temp1 = temp1 + conjg( a( l, i ) )*b( l, j )
2944 temp2 = temp2 + conjg( b( l, i ) )*a( l, j )
2947 IF( beta.EQ.
REAL( ZERO ) )then
2948 c( j, j ) =
REAL( alpha *temp1 +
2949 $ conjg( alpha )*temp2 )
2951 c( j, j ) = beta*
REAL( C( J, J ) ) +
2952 $
REAL( alpha *temp1 +
2953 $ conjg( alpha )*temp2 )
2956 IF( beta.EQ.
REAL( ZERO ) )then
2957 c( i, j ) = alpha*temp1 + conjg( alpha )*temp2
2959 c( i, j ) = beta *c( i, j ) +
2960 $ alpha*temp1 + conjg( alpha )*temp2
2973 SUBROUTINE cher ( UPLO, N, ALPHA, X, INCX, A, LDA )
2976 INTEGER INCX, LDA, N
2979 COMPLEX A( lda, * ), X( * )
3063 parameter( zero = ( 0.0e+0, 0.0e+0 ) )
3066 INTEGER I, INFO, IX, J, JX, KX
3073 INTRINSIC conjg, max,
real 3080 IF ( .NOT.lsame( uplo,
'U' ).AND.
3081 $ .NOT.lsame( uplo,
'L' ) )
THEN 3083 ELSE IF( n.LT.0 )
THEN 3085 ELSE IF( incx.EQ.0 )
THEN 3087 ELSE IF( lda.LT.max( 1, n ) )
THEN 3091 CALL xerbla(
'CHER ', info )
3097 IF( ( n.EQ.0 ).OR.( alpha.EQ.
REAL( ZERO ) ) )
3103 kx = 1 - ( n - 1 )*incx
3104 ELSE IF( incx.NE.1 )
THEN 3112 IF( lsame( uplo,
'U' ) )
THEN 3118 IF( x( j ).NE.zero )
THEN 3119 temp = alpha*conjg( x( j ) )
3121 a( i, j ) = a( i, j ) + x( i )*temp
3123 a( j, j ) =
REAL( A( J, J ) ) +
REAL( x( j )*temp )
3125 a( j, j ) =
REAL( A( J, J ) )
3131 IF( x( jx ).NE.zero )
THEN 3132 temp = alpha*conjg( x( jx ) )
3135 a( i, j ) = a( i, j ) + x( ix )*temp
3138 a( j, j ) =
REAL( A( J, J ) ) +
REAL( x( jx )*temp )
3140 a( j, j ) =
REAL( A( J, J ) )
3151 IF( x( j ).NE.zero )
THEN 3152 temp = alpha*conjg( x( j ) )
3153 a( j, j ) =
REAL( A( J, J ) ) +
REAL( TEMP*X( J ) )
3155 a( i, j ) = a( i, j ) + x( i )*temp
3158 a( j, j ) =
REAL( A( J, J ) )
3164 IF( x( jx ).NE.zero )
THEN 3165 temp = alpha*conjg( x( jx ) )
3166 a( j, j ) =
REAL( A( J, J ) ) +
REAL( TEMP*X( JX ) )
3170 a( i, j ) = a( i, j ) + x( ix )*temp
3173 a( j, j ) =
REAL( A( J, J ) )
3185 SUBROUTINE cherk ( UPLO, TRANS, N, K, ALPHA, A, LDA,
3188 CHARACTER*1 UPLO, TRANS
3189 INTEGER N, K, LDA, LDC
3192 COMPLEX A( lda, * ), C( ldc, * )
3313 INTRINSIC cmplx, conjg, max,
real 3316 INTEGER I, INFO, J, L, NROWA
3321 parameter( one = 1.0e+0, zero = 0.0e+0 )
3327 IF( lsame( trans,
'N' ) )
THEN 3332 upper = lsame( uplo,
'U' )
3335 IF( ( .NOT.upper ).AND.
3336 $ ( .NOT.lsame( uplo ,
'L' ) ) )
THEN 3338 ELSE IF( ( .NOT.lsame( trans,
'N' ) ).AND.
3339 $ ( .NOT.lsame( trans,
'C' ) ) )
THEN 3341 ELSE IF( n .LT.0 )
THEN 3343 ELSE IF( k .LT.0 )
THEN 3345 ELSE IF( lda.LT.max( 1, nrowa ) )
THEN 3347 ELSE IF( ldc.LT.max( 1, n ) )
THEN 3351 CALL xerbla(
'CHERK ', info )
3358 $ ( ( ( alpha.EQ.zero ).OR.( k.EQ.0 ) ).AND.( beta.EQ.one ) ) )
3363 IF( alpha.EQ.zero )
THEN 3365 IF( beta.EQ.zero )
THEN 3374 c( i, j ) = beta*c( i, j )
3376 c( j, j ) = beta*
REAL( C( J, J ) )
3380 IF( beta.EQ.zero )
THEN 3388 c( j, j ) = beta*
REAL( C( J, J ) )
3390 c( i, j ) = beta*c( i, j )
3400 IF( lsame( trans,
'N' ) )
THEN 3406 IF( beta.EQ.zero )
THEN 3410 ELSE IF( beta.NE.one )
THEN 3411 DO 100, i = 1, j - 1
3412 c( i, j ) = beta*c( i, j )
3414 c( j, j ) = beta*
REAL( C( J, J ) )
3416 c( j, j ) =
REAL( C( J, J ) )
3419 IF( a( j, l ).NE.cmplx( zero ) )
THEN 3420 temp = alpha*conjg( a( j, l ) )
3421 DO 110, i = 1, j - 1
3422 c( i, j ) = c( i, j ) + temp*a( i, l )
3424 c( j, j ) =
REAL( C( J, J ) ) +
3425 $
REAL( TEMP*A( I, L ) )
3431 IF( beta.EQ.zero )
THEN 3435 ELSE IF( beta.NE.one )
THEN 3436 c( j, j ) = beta*
REAL( C( J, J ) )
3437 DO 150, i = j + 1, n
3438 c( i, j ) = beta*c( i, j )
3441 c( j, j ) =
REAL( C( J, J ) )
3444 IF( a( j, l ).NE.cmplx( zero ) )
THEN 3445 temp = alpha*conjg( a( j, l ) )
3446 c( j, j ) =
REAL( C( J, J ) ) +
3447 $
REAL( TEMP*A( J, L ) )
3448 DO 160, i = j + 1, n
3449 c( i, j ) = c( i, j ) + temp*a( i, l )
3461 DO 200, i = 1, j - 1
3464 temp = temp + conjg( a( l, i ) )*a( l, j )
3466 IF( beta.EQ.zero )
THEN 3467 c( i, j ) = alpha*temp
3469 c( i, j ) = alpha*temp + beta*c( i, j )
3474 rtemp = rtemp + conjg( a( l, j ) )*a( l, j )
3476 IF( beta.EQ.zero )
THEN 3477 c( j, j ) = alpha*rtemp
3479 c( j, j ) = alpha*rtemp + beta*
REAL( C( J, J ) )
3486 rtemp = rtemp + conjg( a( l, j ) )*a( l, j )
3488 IF( beta.EQ.zero )
THEN 3489 c( j, j ) = alpha*rtemp
3491 c( j, j ) = alpha*rtemp + beta*
REAL( C( J, J ) )
3493 DO 250, i = j + 1, n
3496 temp = temp + conjg( a( l, i ) )*a( l, j )
3498 IF( beta.EQ.zero )
THEN 3499 c( i, j ) = alpha*temp
3501 c( i, j ) = alpha*temp + beta*c( i, j )
3513 SUBROUTINE chpmv ( UPLO, N, ALPHA, AP, X, INCX, BETA, Y, INCY )
3516 INTEGER INCX, INCY, N
3519 COMPLEX AP( * ), X( * ), Y( * )
3612 parameter( one = ( 1.0e+0, 0.0e+0 ) )
3614 parameter( zero = ( 0.0e+0, 0.0e+0 ) )
3616 COMPLEX TEMP1, TEMP2
3617 INTEGER I, INFO, IX, IY, J, JX, JY, K, KK, KX, KY
3624 INTRINSIC conjg,
real 3631 IF ( .NOT.lsame( uplo,
'U' ).AND.
3632 $ .NOT.lsame( uplo,
'L' ) )
THEN 3634 ELSE IF( n.LT.0 )
THEN 3636 ELSE IF( incx.EQ.0 )
THEN 3638 ELSE IF( incy.EQ.0 )
THEN 3642 CALL xerbla(
'CHPMV ', info )
3648 IF( ( n.EQ.0 ).OR.( ( alpha.EQ.zero ).AND.( beta.EQ.one ) ) )
3656 kx = 1 - ( n - 1 )*incx
3661 ky = 1 - ( n - 1 )*incy
3669 IF( beta.NE.one )
THEN 3671 IF( beta.EQ.zero )
THEN 3677 y( i ) = beta*y( i )
3682 IF( beta.EQ.zero )
THEN 3689 y( iy ) = beta*y( iy )
3698 IF( lsame( uplo,
'U' ) )
THEN 3702 IF( ( incx.EQ.1 ).AND.( incy.EQ.1 ) )
THEN 3704 temp1 = alpha*x( j )
3708 y( i ) = y( i ) + temp1*ap( k )
3709 temp2 = temp2 + conjg( ap( k ) )*x( i )
3712 y( j ) = y( j ) + temp1*
REAL( AP( KK + J - 1 ) )
3720 temp1 = alpha*x( jx )
3724 DO 70, k = kk, kk + j - 2
3725 y( iy ) = y( iy ) + temp1*ap( k )
3726 temp2 = temp2 + conjg( ap( k ) )*x( ix )
3730 y( jy ) = y( jy ) + temp1*
REAL( AP( KK + J - 1 ) )
3741 IF( ( incx.EQ.1 ).AND.( incy.EQ.1 ) )
THEN 3743 temp1 = alpha*x( j )
3745 y( j ) = y( j ) + temp1*
REAL( AP( KK ) )
3748 y( i ) = y( i ) + temp1*ap( k )
3749 temp2 = temp2 + conjg( ap( k ) )*x( i )
3752 y( j ) = y( j ) + alpha*temp2
3753 kk = kk + ( n - j + 1 )
3759 temp1 = alpha*x( jx )
3761 y( jy ) = y( jy ) + temp1*
REAL( AP( KK ) )
3764 DO 110, k = kk + 1, kk + n - j
3767 y( iy ) = y( iy ) + temp1*ap( k )
3768 temp2 = temp2 + conjg( ap( k ) )*x( ix )
3770 y( jy ) = y( jy ) + alpha*temp2
3773 kk = kk + ( n - j + 1 )
3783 SUBROUTINE chpr2 ( UPLO, N, ALPHA, X, INCX, Y, INCY, AP )
3786 INTEGER INCX, INCY, N
3789 COMPLEX AP( * ), X( * ), Y( * )
3881 parameter( zero = ( 0.0e+0, 0.0e+0 ) )
3883 COMPLEX TEMP1, TEMP2
3884 INTEGER I, INFO, IX, IY, J, JX, JY, K, KK, KX, KY
3891 INTRINSIC conjg,
real 3898 IF ( .NOT.lsame( uplo,
'U' ).AND.
3899 $ .NOT.lsame( uplo,
'L' ) )
THEN 3901 ELSE IF( n.LT.0 )
THEN 3903 ELSE IF( incx.EQ.0 )
THEN 3905 ELSE IF( incy.EQ.0 )
THEN 3909 CALL xerbla(
'CHPR2 ', info )
3915 IF( ( n.EQ.0 ).OR.( alpha.EQ.zero ) )
3921 IF( ( incx.NE.1 ).OR.( incy.NE.1 ) )
THEN 3925 kx = 1 - ( n - 1 )*incx
3930 ky = 1 - ( n - 1 )*incy
3940 IF( lsame( uplo,
'U' ) )
THEN 3944 IF( ( incx.EQ.1 ).AND.( incy.EQ.1 ) )
THEN 3946 IF( ( x( j ).NE.zero ).OR.( y( j ).NE.zero ) )
THEN 3947 temp1 = alpha*conjg( y( j ) )
3948 temp2 = conjg( alpha*x( j ) )
3951 ap( k ) = ap( k ) + x( i )*temp1 + y( i )*temp2
3954 ap( kk + j - 1 ) =
REAL( AP( KK + J - 1 ) ) +
3955 $
REAL( x( j )*temp1 + y( j )*temp2 )
3957 ap( kk + j - 1 ) =
REAL( AP( KK + J - 1 ) )
3963 IF( ( x( jx ).NE.zero ).OR.( y( jy ).NE.zero ) )
THEN 3964 temp1 = alpha*conjg( y( jy ) )
3965 temp2 = conjg( alpha*x( jx ) )
3968 DO 30, k = kk, kk + j - 2
3969 ap( k ) = ap( k ) + x( ix )*temp1 + y( iy )*temp2
3973 ap( kk + j - 1 ) =
REAL( AP( KK + J - 1 ) ) +
3974 $
REAL( x( jx )*temp1 +
3977 ap( kk + j - 1 ) =
REAL( AP( KK + J - 1 ) )
3988 IF( ( incx.EQ.1 ).AND.( incy.EQ.1 ) )
THEN 3990 IF( ( x( j ).NE.zero ).OR.( y( j ).NE.zero ) )
THEN 3991 temp1 = alpha*conjg( y( j ) )
3992 temp2 = conjg( alpha*x( j ) )
3993 ap( kk ) =
REAL( AP( KK ) ) +
3994 $
REAL( x( j )*temp1 + y( j )*temp2 )
3997 ap( k ) = ap( k ) + x( i )*temp1 + y( i )*temp2
4001 ap( kk ) =
REAL( AP( KK ) )
4007 IF( ( x( jx ).NE.zero ).OR.( y( jy ).NE.zero ) )
THEN 4008 temp1 = alpha*conjg( y( jy ) )
4009 temp2 = conjg( alpha*x( jx ) )
4010 ap( kk ) =
REAL( AP( KK ) ) +
4011 $
REAL( x( jx )*temp1 + y( jy )*temp2 )
4014 DO 70, k = kk + 1, kk + n - j
4017 ap( k ) = ap( k ) + x( ix )*temp1 + y( iy )*temp2
4020 ap( kk ) =
REAL( AP( KK ) )
4034 SUBROUTINE chpr ( UPLO, N, ALPHA, X, INCX, AP )
4040 COMPLEX AP( * ), X( * )
4121 parameter( zero = ( 0.0e+0, 0.0e+0 ) )
4124 INTEGER I, INFO, IX, J, JX, K, KK, KX
4131 INTRINSIC conjg,
real 4138 IF ( .NOT.lsame( uplo,
'U' ).AND.
4139 $ .NOT.lsame( uplo,
'L' ) )
THEN 4141 ELSE IF( n.LT.0 )
THEN 4143 ELSE IF( incx.EQ.0 )
THEN 4147 CALL xerbla(
'CHPR ', info )
4153 IF( ( n.EQ.0 ).OR.( alpha.EQ.
REAL( ZERO ) ) )
4159 kx = 1 - ( n - 1 )*incx
4160 ELSE IF( incx.NE.1 )
THEN 4168 IF( lsame( uplo,
'U' ) )
THEN 4174 IF( x( j ).NE.zero )
THEN 4175 temp = alpha*conjg( x( j ) )
4178 ap( k ) = ap( k ) + x( i )*temp
4181 ap( kk + j - 1 ) =
REAL( AP( KK + J - 1 ) )
4182 $ +
REAL( x( j )*temp )
4184 ap( kk + j - 1 ) =
REAL( AP( KK + J - 1 ) )
4191 IF( x( jx ).NE.zero )
THEN 4192 temp = alpha*conjg( x( jx ) )
4194 DO 30, k = kk, kk + j - 2
4195 ap( k ) = ap( k ) + x( ix )*temp
4198 ap( kk + j - 1 ) =
REAL( AP( KK + J - 1 ) )
4199 $ +
REAL( x( jx )*temp )
4201 ap( kk + j - 1 ) =
REAL( AP( KK + J - 1 ) )
4213 IF( x( j ).NE.zero )
THEN 4214 temp = alpha*conjg( x( j ) )
4215 ap( kk ) =
REAL( AP( KK ) ) +
REAL( TEMP*X( J ) )
4218 ap( k ) = ap( k ) + x( i )*temp
4222 ap( kk ) =
REAL( AP( KK ) )
4229 IF( x( jx ).NE.zero )
THEN 4230 temp = alpha*conjg( x( jx ) )
4231 ap( kk ) =
REAL( AP( KK ) ) +
REAL( TEMP*X( JX ) )
4233 DO 70, k = kk + 1, kk + n - j
4235 ap( k ) = ap( k ) + x( ix )*temp
4238 ap( kk ) =
REAL( AP( KK ) )
4251 subroutine crotg(ca,cb,c,s)
4256 if (cabs(ca) .ne. 0.)
go to 10
4262 scale = cabs(ca) + cabs(cb)
4263 norm = scale * sqrt((cabs(ca/scale))**2 + (cabs(cb/scale))**2)
4264 alpha = ca /cabs(ca)
4266 s = alpha * conjg(cb) / norm
4271 subroutine cscal(n,ca,cx,incx)
4279 integer i,incx,n,nincx
4281 if( n.le.0 .or. incx.le.0 )
return 4282 if(incx.eq.1)
go to 20
4287 do 10 i = 1,nincx,incx
4299 subroutine csrot (n,cx,incx,cy,incy,c,s)
4305 complex cx(1),cy(1),ctemp
4307 integer i,incx,incy,ix,iy,n
4310 if(incx.eq.1.and.incy.eq.1)
go to 20
4317 if(incx.lt.0)ix = (-n+1)*incx + 1
4318 if(incy.lt.0)iy = (-n+1)*incy + 1
4320 ctemp = c*cx(ix) + s*cy(iy)
4321 cy(iy) = c*cy(iy) - s*cx(ix)
4331 ctemp = c*cx(i) + s*cy(i)
4332 cy(i) = c*cy(i) - s*cx(i)
4337 subroutine csscal(n,sa,cx,incx)
4346 integer i,incx,n,nincx
4348 if( n.le.0 .or. incx.le.0 )
return 4349 if(incx.eq.1)
go to 20
4354 do 10 i = 1,nincx,incx
4355 cx(i) = cmplx(sa*
real(cx(i)),sa*aimag(cx(i)))
4362 cx(i) = cmplx(sa*
real(cx(i)),sa*aimag(cx(i)))
4366 subroutine cswap (n,cx,incx,cy,incy)
4372 complex cx(*),cy(*),ctemp
4373 integer i,incx,incy,ix,iy,n
4376 if(incx.eq.1.and.incy.eq.1)
go to 20
4383 if(incx.lt.0)ix = (-n+1)*incx + 1
4384 if(incy.lt.0)iy = (-n+1)*incy + 1
4402 SUBROUTINE csymm ( SIDE, UPLO, M, N, ALPHA, A, LDA, B, LDB,
4405 CHARACTER*1 SIDE, UPLO
4406 INTEGER M, N, LDA, LDB, LDC
4409 COMPLEX A( lda, * ), B( ldb, * ), C( ldc, * )
4545 INTEGER I, INFO, J, K, NROWA
4546 COMPLEX TEMP1, TEMP2
4549 parameter( one = ( 1.0e+0, 0.0e+0 ) )
4551 parameter( zero = ( 0.0e+0, 0.0e+0 ) )
4557 IF( lsame( side,
'L' ) )
THEN 4562 upper = lsame( uplo,
'U' )
4567 IF( ( .NOT.lsame( side,
'L' ) ).AND.
4568 $ ( .NOT.lsame( side,
'R' ) ) )
THEN 4570 ELSE IF( ( .NOT.upper ).AND.
4571 $ ( .NOT.lsame( uplo,
'L' ) ) )
THEN 4573 ELSE IF( m .LT.0 )
THEN 4575 ELSE IF( n .LT.0 )
THEN 4577 ELSE IF( lda.LT.max( 1, nrowa ) )
THEN 4579 ELSE IF( ldb.LT.max( 1, m ) )
THEN 4581 ELSE IF( ldc.LT.max( 1, m ) )
THEN 4585 CALL xerbla(
'CSYMM ', info )
4591 IF( ( m.EQ.0 ).OR.( n.EQ.0 ).OR.
4592 $ ( ( alpha.EQ.zero ).AND.( beta.EQ.one ) ) )
4597 IF( alpha.EQ.zero )
THEN 4598 IF( beta.EQ.zero )
THEN 4607 c( i, j ) = beta*c( i, j )
4616 IF( lsame( side,
'L' ) )
THEN 4623 temp1 = alpha*b( i, j )
4626 c( k, j ) = c( k, j ) + temp1 *a( k, i )
4627 temp2 = temp2 + b( k, j )*a( k, i )
4629 IF( beta.EQ.zero )
THEN 4630 c( i, j ) = temp1*a( i, i ) + alpha*temp2
4632 c( i, j ) = beta *c( i, j ) +
4633 $ temp1*a( i, i ) + alpha*temp2
4640 temp1 = alpha*b( i, j )
4643 c( k, j ) = c( k, j ) + temp1 *a( k, i )
4644 temp2 = temp2 + b( k, j )*a( k, i )
4646 IF( beta.EQ.zero )
THEN 4647 c( i, j ) = temp1*a( i, i ) + alpha*temp2
4649 c( i, j ) = beta *c( i, j ) +
4650 $ temp1*a( i, i ) + alpha*temp2
4660 temp1 = alpha*a( j, j )
4661 IF( beta.EQ.zero )
THEN 4663 c( i, j ) = temp1*b( i, j )
4667 c( i, j ) = beta*c( i, j ) + temp1*b( i, j )
4670 DO 140, k = 1, j - 1
4672 temp1 = alpha*a( k, j )
4674 temp1 = alpha*a( j, k )
4677 c( i, j ) = c( i, j ) + temp1*b( i, k )
4680 DO 160, k = j + 1, n
4682 temp1 = alpha*a( j, k )
4684 temp1 = alpha*a( k, j )
4687 c( i, j ) = c( i, j ) + temp1*b( i, k )
4698 SUBROUTINE csyr2k( UPLO, TRANS, N, K, ALPHA, A, LDA, B, LDB,
4701 CHARACTER*1 UPLO, TRANS
4702 INTEGER N, K, LDA, LDB, LDC
4705 COMPLEX A( lda, * ), B( ldb, * ), C( ldc, * )
4840 INTEGER I, INFO, J, L, NROWA
4841 COMPLEX TEMP1, TEMP2
4844 parameter( one = ( 1.0e+0, 0.0e+0 ) )
4846 parameter( zero = ( 0.0e+0, 0.0e+0 ) )
4852 IF( lsame( trans,
'N' ) )
THEN 4857 upper = lsame( uplo,
'U' )
4860 IF( ( .NOT.upper ).AND.
4861 $ ( .NOT.lsame( uplo ,
'L' ) ) )
THEN 4863 ELSE IF( ( .NOT.lsame( trans,
'N' ) ).AND.
4864 $ ( .NOT.lsame( trans,
'T' ) ) )
THEN 4866 ELSE IF( n .LT.0 )
THEN 4868 ELSE IF( k .LT.0 )
THEN 4870 ELSE IF( lda.LT.max( 1, nrowa ) )
THEN 4872 ELSE IF( ldb.LT.max( 1, nrowa ) )
THEN 4874 ELSE IF( ldc.LT.max( 1, n ) )
THEN 4878 CALL xerbla(
'CSYR2K', info )
4885 $ ( ( ( alpha.EQ.zero ).OR.( k.EQ.0 ) ).AND.( beta.EQ.one ) ) )
4890 IF( alpha.EQ.zero )
THEN 4892 IF( beta.EQ.zero )
THEN 4901 c( i, j ) = beta*c( i, j )
4906 IF( beta.EQ.zero )
THEN 4915 c( i, j ) = beta*c( i, j )
4925 IF( lsame( trans,
'N' ) )
THEN 4931 IF( beta.EQ.zero )
THEN 4935 ELSE IF( beta.NE.one )
THEN 4937 c( i, j ) = beta*c( i, j )
4941 IF( ( a( j, l ).NE.zero ).OR.
4942 $ ( b( j, l ).NE.zero ) )
THEN 4943 temp1 = alpha*b( j, l )
4944 temp2 = alpha*a( j, l )
4946 c( i, j ) = c( i, j ) + a( i, l )*temp1 +
4954 IF( beta.EQ.zero )
THEN 4958 ELSE IF( beta.NE.one )
THEN 4960 c( i, j ) = beta*c( i, j )
4964 IF( ( a( j, l ).NE.zero ).OR.
4965 $ ( b( j, l ).NE.zero ) )
THEN 4966 temp1 = alpha*b( j, l )
4967 temp2 = alpha*a( j, l )
4969 c( i, j ) = c( i, j ) + a( i, l )*temp1 +
4986 temp1 = temp1 + a( l, i )*b( l, j )
4987 temp2 = temp2 + b( l, i )*a( l, j )
4989 IF( beta.EQ.zero )
THEN 4990 c( i, j ) = alpha*temp1 + alpha*temp2
4992 c( i, j ) = beta *c( i, j ) +
4993 $ alpha*temp1 + alpha*temp2
5003 temp1 = temp1 + a( l, i )*b( l, j )
5004 temp2 = temp2 + b( l, i )*a( l, j )
5006 IF( beta.EQ.zero )
THEN 5007 c( i, j ) = alpha*temp1 + alpha*temp2
5009 c( i, j ) = beta *c( i, j ) +
5010 $ alpha*temp1 + alpha*temp2
5022 SUBROUTINE csyrk ( UPLO, TRANS, N, K, ALPHA, A, LDA,
5025 CHARACTER*1 UPLO, TRANS
5026 INTEGER N, K, LDA, LDC
5029 COMPLEX A( lda, * ), C( ldc, * )
5147 INTEGER I, INFO, J, L, NROWA
5151 parameter( one = ( 1.0e+0, 0.0e+0 ) )
5153 parameter( zero = ( 0.0e+0, 0.0e+0 ) )
5159 IF( lsame( trans,
'N' ) )
THEN 5164 upper = lsame( uplo,
'U' )
5167 IF( ( .NOT.upper ).AND.
5168 $ ( .NOT.lsame( uplo ,
'L' ) ) )
THEN 5170 ELSE IF( ( .NOT.lsame( trans,
'N' ) ).AND.
5171 $ ( .NOT.lsame( trans,
'T' ) ) )
THEN 5173 ELSE IF( n .LT.0 )
THEN 5175 ELSE IF( k .LT.0 )
THEN 5177 ELSE IF( lda.LT.max( 1, nrowa ) )
THEN 5179 ELSE IF( ldc.LT.max( 1, n ) )
THEN 5183 CALL xerbla(
'CSYRK ', info )
5190 $ ( ( ( alpha.EQ.zero ).OR.( k.EQ.0 ) ).AND.( beta.EQ.one ) ) )
5195 IF( alpha.EQ.zero )
THEN 5197 IF( beta.EQ.zero )
THEN 5206 c( i, j ) = beta*c( i, j )
5211 IF( beta.EQ.zero )
THEN 5220 c( i, j ) = beta*c( i, j )
5230 IF( lsame( trans,
'N' ) )
THEN 5236 IF( beta.EQ.zero )
THEN 5240 ELSE IF( beta.NE.one )
THEN 5242 c( i, j ) = beta*c( i, j )
5246 IF( a( j, l ).NE.zero )
THEN 5247 temp = alpha*a( j, l )
5249 c( i, j ) = c( i, j ) + temp*a( i, l )
5256 IF( beta.EQ.zero )
THEN 5260 ELSE IF( beta.NE.one )
THEN 5262 c( i, j ) = beta*c( i, j )
5266 IF( a( j, l ).NE.zero )
THEN 5267 temp = alpha*a( j, l )
5269 c( i, j ) = c( i, j ) + temp*a( i, l )
5284 temp = temp + a( l, i )*a( l, j )
5286 IF( beta.EQ.zero )
THEN 5287 c( i, j ) = alpha*temp
5289 c( i, j ) = alpha*temp + beta*c( i, j )
5298 temp = temp + a( l, i )*a( l, j )
5300 IF( beta.EQ.zero )
THEN 5301 c( i, j ) = alpha*temp
5303 c( i, j ) = alpha*temp + beta*c( i, j )
5315 SUBROUTINE ctbmv ( UPLO, TRANS, DIAG, N, K, A, LDA, X, INCX )
5317 INTEGER INCX, K, LDA, N
5318 CHARACTER*1 DIAG, TRANS, UPLO
5320 COMPLEX A( lda, * ), X( * )
5453 parameter( zero = ( 0.0e+0, 0.0e+0 ) )
5456 INTEGER I, INFO, IX, J, JX, KPLUS1, KX, L
5457 LOGICAL NOCONJ, NOUNIT
5464 INTRINSIC conjg, max, min
5471 IF ( .NOT.lsame( uplo ,
'U' ).AND.
5472 $ .NOT.lsame( uplo ,
'L' ) )
THEN 5474 ELSE IF( .NOT.lsame( trans,
'N' ).AND.
5475 $ .NOT.lsame( trans,
'T' ).AND.
5476 $ .NOT.lsame( trans,
'C' ) )
THEN 5478 ELSE IF( .NOT.lsame( diag ,
'U' ).AND.
5479 $ .NOT.lsame( diag ,
'N' ) )
THEN 5481 ELSE IF( n.LT.0 )
THEN 5483 ELSE IF( k.LT.0 )
THEN 5485 ELSE IF( lda.LT.( k + 1 ) )
THEN 5487 ELSE IF( incx.EQ.0 )
THEN 5491 CALL xerbla(
'CTBMV ', info )
5500 noconj = lsame( trans,
'T' )
5501 nounit = lsame( diag ,
'N' )
5507 kx = 1 - ( n - 1 )*incx
5508 ELSE IF( incx.NE.1 )
THEN 5515 IF( lsame( trans,
'N' ) )
THEN 5519 IF( lsame( uplo,
'U' ) )
THEN 5523 IF( x( j ).NE.zero )
THEN 5526 DO 10, i = max( 1, j - k ), j - 1
5527 x( i ) = x( i ) + temp*a( l + i, j )
5530 $ x( j ) = x( j )*a( kplus1, j )
5536 IF( x( jx ).NE.zero )
THEN 5540 DO 30, i = max( 1, j - k ), j - 1
5541 x( ix ) = x( ix ) + temp*a( l + i, j )
5545 $ x( jx ) = x( jx )*a( kplus1, j )
5555 IF( x( j ).NE.zero )
THEN 5558 DO 50, i = min( n, j + k ), j + 1, -1
5559 x( i ) = x( i ) + temp*a( l + i, j )
5562 $ x( j ) = x( j )*a( 1, j )
5566 kx = kx + ( n - 1 )*incx
5569 IF( x( jx ).NE.zero )
THEN 5573 DO 70, i = min( n, j + k ), j + 1, -1
5574 x( ix ) = x( ix ) + temp*a( l + i, j )
5578 $ x( jx ) = x( jx )*a( 1, j )
5581 IF( ( n - j ).GE.k )
5590 IF( lsame( uplo,
'U' ) )
THEN 5593 DO 110, j = n, 1, -1
5598 $ temp = temp*a( kplus1, j )
5599 DO 90, i = j - 1, max( 1, j - k ), -1
5600 temp = temp + a( l + i, j )*x( i )
5604 $ temp = temp*conjg( a( kplus1, j ) )
5605 DO 100, i = j - 1, max( 1, j - k ), -1
5606 temp = temp + conjg( a( l + i, j ) )*x( i )
5612 kx = kx + ( n - 1 )*incx
5614 DO 140, j = n, 1, -1
5621 $ temp = temp*a( kplus1, j )
5622 DO 120, i = j - 1, max( 1, j - k ), -1
5623 temp = temp + a( l + i, j )*x( ix )
5628 $ temp = temp*conjg( a( kplus1, j ) )
5629 DO 130, i = j - 1, max( 1, j - k ), -1
5630 temp = temp + conjg( a( l + i, j ) )*x( ix )
5645 $ temp = temp*a( 1, j )
5646 DO 150, i = j + 1, min( n, j + k )
5647 temp = temp + a( l + i, j )*x( i )
5651 $ temp = temp*conjg( a( 1, j ) )
5652 DO 160, i = j + 1, min( n, j + k )
5653 temp = temp + conjg( a( l + i, j ) )*x( i )
5667 $ temp = temp*a( 1, j )
5668 DO 180, i = j + 1, min( n, j + k )
5669 temp = temp + a( l + i, j )*x( ix )
5674 $ temp = temp*conjg( a( 1, j ) )
5675 DO 190, i = j + 1, min( n, j + k )
5676 temp = temp + conjg( a( l + i, j ) )*x( ix )
5692 SUBROUTINE ctbsv ( UPLO, TRANS, DIAG, N, K, A, LDA, X, INCX )
5694 INTEGER INCX, K, LDA, N
5695 CHARACTER*1 DIAG, TRANS, UPLO
5697 COMPLEX A( lda, * ), X( * )
5834 parameter( zero = ( 0.0e+0, 0.0e+0 ) )
5837 INTEGER I, INFO, IX, J, JX, KPLUS1, KX, L
5838 LOGICAL NOCONJ, NOUNIT
5845 INTRINSIC conjg, max, min
5852 IF ( .NOT.lsame( uplo ,
'U' ).AND.
5853 $ .NOT.lsame( uplo ,
'L' ) )
THEN 5855 ELSE IF( .NOT.lsame( trans,
'N' ).AND.
5856 $ .NOT.lsame( trans,
'T' ).AND.
5857 $ .NOT.lsame( trans,
'C' ) )
THEN 5859 ELSE IF( .NOT.lsame( diag ,
'U' ).AND.
5860 $ .NOT.lsame( diag ,
'N' ) )
THEN 5862 ELSE IF( n.LT.0 )
THEN 5864 ELSE IF( k.LT.0 )
THEN 5866 ELSE IF( lda.LT.( k + 1 ) )
THEN 5868 ELSE IF( incx.EQ.0 )
THEN 5872 CALL xerbla(
'CTBSV ', info )
5881 noconj = lsame( trans,
'T' )
5882 nounit = lsame( diag ,
'N' )
5888 kx = 1 - ( n - 1 )*incx
5889 ELSE IF( incx.NE.1 )
THEN 5896 IF( lsame( trans,
'N' ) )
THEN 5900 IF( lsame( uplo,
'U' ) )
THEN 5904 IF( x( j ).NE.zero )
THEN 5907 $ x( j ) = x( j )/a( kplus1, j )
5909 DO 10, i = j - 1, max( 1, j - k ), -1
5910 x( i ) = x( i ) - temp*a( l + i, j )
5915 kx = kx + ( n - 1 )*incx
5919 IF( x( jx ).NE.zero )
THEN 5923 $ x( jx ) = x( jx )/a( kplus1, j )
5925 DO 30, i = j - 1, max( 1, j - k ), -1
5926 x( ix ) = x( ix ) - temp*a( l + i, j )
5936 IF( x( j ).NE.zero )
THEN 5939 $ x( j ) = x( j )/a( 1, j )
5941 DO 50, i = j + 1, min( n, j + k )
5942 x( i ) = x( i ) - temp*a( l + i, j )
5950 IF( x( jx ).NE.zero )
THEN 5954 $ x( jx ) = x( jx )/a( 1, j )
5956 DO 70, i = j + 1, min( n, j + k )
5957 x( ix ) = x( ix ) - temp*a( l + i, j )
5969 IF( lsame( uplo,
'U' ) )
THEN 5976 DO 90, i = max( 1, j - k ), j - 1
5977 temp = temp - a( l + i, j )*x( i )
5980 $ temp = temp/a( kplus1, j )
5982 DO 100, i = max( 1, j - k ), j - 1
5983 temp = temp - conjg( a( l + i, j ) )*x( i )
5986 $ temp = temp/conjg( a( kplus1, j ) )
5997 DO 120, i = max( 1, j - k ), j - 1
5998 temp = temp - a( l + i, j )*x( ix )
6002 $ temp = temp/a( kplus1, j )
6004 DO 130, i = max( 1, j - k ), j - 1
6005 temp = temp - conjg( a( l + i, j ) )*x( ix )
6009 $ temp = temp/conjg( a( kplus1, j ) )
6019 DO 170, j = n, 1, -1
6023 DO 150, i = min( n, j + k ), j + 1, -1
6024 temp = temp - a( l + i, j )*x( i )
6027 $ temp = temp/a( 1, j )
6029 DO 160, i = min( n, j + k ), j + 1, -1
6030 temp = temp - conjg( a( l + i, j ) )*x( i )
6033 $ temp = temp/conjg( a( 1, j ) )
6038 kx = kx + ( n - 1 )*incx
6040 DO 200, j = n, 1, -1
6045 DO 180, i = min( n, j + k ), j + 1, -1
6046 temp = temp - a( l + i, j )*x( ix )
6050 $ temp = temp/a( 1, j )
6052 DO 190, i = min( n, j + k ), j + 1, -1
6053 temp = temp - conjg( a( l + i, j ) )*x( ix )
6057 $ temp = temp/conjg( a( 1, j ) )
6061 IF( ( n - j ).GE.k )
6073 SUBROUTINE ctpmv ( UPLO, TRANS, DIAG, N, AP, X, INCX )
6076 CHARACTER*1 DIAG, TRANS, UPLO
6078 COMPLEX AP( * ), X( * )
6171 parameter( zero = ( 0.0e+0, 0.0e+0 ) )
6174 INTEGER I, INFO, IX, J, JX, K, KK, KX
6175 LOGICAL NOCONJ, NOUNIT
6189 IF ( .NOT.lsame( uplo ,
'U' ).AND.
6190 $ .NOT.lsame( uplo ,
'L' ) )
THEN 6192 ELSE IF( .NOT.lsame( trans,
'N' ).AND.
6193 $ .NOT.lsame( trans,
'T' ).AND.
6194 $ .NOT.lsame( trans,
'C' ) )
THEN 6196 ELSE IF( .NOT.lsame( diag ,
'U' ).AND.
6197 $ .NOT.lsame( diag ,
'N' ) )
THEN 6199 ELSE IF( n.LT.0 )
THEN 6201 ELSE IF( incx.EQ.0 )
THEN 6205 CALL xerbla(
'CTPMV ', info )
6214 noconj = lsame( trans,
'T' )
6215 nounit = lsame( diag ,
'N' )
6221 kx = 1 - ( n - 1 )*incx
6222 ELSE IF( incx.NE.1 )
THEN 6229 IF( lsame( trans,
'N' ) )
THEN 6233 IF( lsame( uplo,
'U' ) )
THEN 6237 IF( x( j ).NE.zero )
THEN 6241 x( i ) = x( i ) + temp*ap( k )
6245 $ x( j ) = x( j )*ap( kk + j - 1 )
6252 IF( x( jx ).NE.zero )
THEN 6255 DO 30, k = kk, kk + j - 2
6256 x( ix ) = x( ix ) + temp*ap( k )
6260 $ x( jx ) = x( jx )*ap( kk + j - 1 )
6267 kk = ( n*( n + 1 ) )/2
6270 IF( x( j ).NE.zero )
THEN 6273 DO 50, i = n, j + 1, -1
6274 x( i ) = x( i ) + temp*ap( k )
6278 $ x( j ) = x( j )*ap( kk - n + j )
6280 kk = kk - ( n - j + 1 )
6283 kx = kx + ( n - 1 )*incx
6286 IF( x( jx ).NE.zero )
THEN 6289 DO 70, k = kk, kk - ( n - ( j + 1 ) ), -1
6290 x( ix ) = x( ix ) + temp*ap( k )
6294 $ x( jx ) = x( jx )*ap( kk - n + j )
6297 kk = kk - ( n - j + 1 )
6305 IF( lsame( uplo,
'U' ) )
THEN 6306 kk = ( n*( n + 1 ) )/2
6308 DO 110, j = n, 1, -1
6313 $ temp = temp*ap( kk )
6314 DO 90, i = j - 1, 1, -1
6315 temp = temp + ap( k )*x( i )
6320 $ temp = temp*conjg( ap( kk ) )
6321 DO 100, i = j - 1, 1, -1
6322 temp = temp + conjg( ap( k ) )*x( i )
6330 jx = kx + ( n - 1 )*incx
6331 DO 140, j = n, 1, -1
6336 $ temp = temp*ap( kk )
6337 DO 120, k = kk - 1, kk - j + 1, -1
6339 temp = temp + ap( k )*x( ix )
6343 $ temp = temp*conjg( ap( kk ) )
6344 DO 130, k = kk - 1, kk - j + 1, -1
6346 temp = temp + conjg( ap( k ) )*x( ix )
6362 $ temp = temp*ap( kk )
6363 DO 150, i = j + 1, n
6364 temp = temp + ap( k )*x( i )
6369 $ temp = temp*conjg( ap( kk ) )
6370 DO 160, i = j + 1, n
6371 temp = temp + conjg( ap( k ) )*x( i )
6376 kk = kk + ( n - j + 1 )
6385 $ temp = temp*ap( kk )
6386 DO 180, k = kk + 1, kk + n - j
6388 temp = temp + ap( k )*x( ix )
6392 $ temp = temp*conjg( ap( kk ) )
6393 DO 190, k = kk + 1, kk + n - j
6395 temp = temp + conjg( ap( k ) )*x( ix )
6400 kk = kk + ( n - j + 1 )
6411 SUBROUTINE ctpsv ( UPLO, TRANS, DIAG, N, AP, X, INCX )
6414 CHARACTER*1 DIAG, TRANS, UPLO
6416 COMPLEX AP( * ), X( * )
6512 parameter( zero = ( 0.0e+0, 0.0e+0 ) )
6515 INTEGER I, INFO, IX, J, JX, K, KK, KX
6516 LOGICAL NOCONJ, NOUNIT
6530 IF ( .NOT.lsame( uplo ,
'U' ).AND.
6531 $ .NOT.lsame( uplo ,
'L' ) )
THEN 6533 ELSE IF( .NOT.lsame( trans,
'N' ).AND.
6534 $ .NOT.lsame( trans,
'T' ).AND.
6535 $ .NOT.lsame( trans,
'C' ) )
THEN 6537 ELSE IF( .NOT.lsame( diag ,
'U' ).AND.
6538 $ .NOT.lsame( diag ,
'N' ) )
THEN 6540 ELSE IF( n.LT.0 )
THEN 6542 ELSE IF( incx.EQ.0 )
THEN 6546 CALL xerbla(
'CTPSV ', info )
6555 noconj = lsame( trans,
'T' )
6556 nounit = lsame( diag ,
'N' )
6562 kx = 1 - ( n - 1 )*incx
6563 ELSE IF( incx.NE.1 )
THEN 6570 IF( lsame( trans,
'N' ) )
THEN 6574 IF( lsame( uplo,
'U' ) )
THEN 6575 kk = ( n*( n + 1 ) )/2
6578 IF( x( j ).NE.zero )
THEN 6580 $ x( j ) = x( j )/ap( kk )
6583 DO 10, i = j - 1, 1, -1
6584 x( i ) = x( i ) - temp*ap( k )
6591 jx = kx + ( n - 1 )*incx
6593 IF( x( jx ).NE.zero )
THEN 6595 $ x( jx ) = x( jx )/ap( kk )
6598 DO 30, k = kk - 1, kk - j + 1, -1
6600 x( ix ) = x( ix ) - temp*ap( k )
6611 IF( x( j ).NE.zero )
THEN 6613 $ x( j ) = x( j )/ap( kk )
6617 x( i ) = x( i ) - temp*ap( k )
6621 kk = kk + ( n - j + 1 )
6626 IF( x( jx ).NE.zero )
THEN 6628 $ x( jx ) = x( jx )/ap( kk )
6631 DO 70, k = kk + 1, kk + n - j
6633 x( ix ) = x( ix ) - temp*ap( k )
6637 kk = kk + ( n - j + 1 )
6645 IF( lsame( uplo,
'U' ) )
THEN 6653 temp = temp - ap( k )*x( i )
6657 $ temp = temp/ap( kk + j - 1 )
6659 DO 100, i = 1, j - 1
6660 temp = temp - conjg( ap( k ) )*x( i )
6664 $ temp = temp/conjg( ap( kk + j - 1 ) )
6675 DO 120, k = kk, kk + j - 2
6676 temp = temp - ap( k )*x( ix )
6680 $ temp = temp/ap( kk + j - 1 )
6682 DO 130, k = kk, kk + j - 2
6683 temp = temp - conjg( ap( k ) )*x( ix )
6687 $ temp = temp/conjg( ap( kk + j - 1 ) )
6695 kk = ( n*( n + 1 ) )/2
6697 DO 170, j = n, 1, -1
6701 DO 150, i = n, j + 1, -1
6702 temp = temp - ap( k )*x( i )
6706 $ temp = temp/ap( kk - n + j )
6708 DO 160, i = n, j + 1, -1
6709 temp = temp - conjg( ap( k ) )*x( i )
6713 $ temp = temp/conjg( ap( kk - n + j ) )
6716 kk = kk - ( n - j + 1 )
6719 kx = kx + ( n - 1 )*incx
6721 DO 200, j = n, 1, -1
6725 DO 180, k = kk, kk - ( n - ( j + 1 ) ), -1
6726 temp = temp - ap( k )*x( ix )
6730 $ temp = temp/ap( kk - n + j )
6732 DO 190, k = kk, kk - ( n - ( j + 1 ) ), -1
6733 temp = temp - conjg( ap( k ) )*x( ix )
6737 $ temp = temp/conjg( ap( kk - n + j ) )
6741 kk = kk - ( n - j + 1 )
6752 SUBROUTINE ctrmm ( SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA,
6755 CHARACTER*1 SIDE, UPLO, TRANSA, DIAG
6756 INTEGER M, N, LDA, LDB
6759 COMPLEX A( lda, * ), B( ldb, * )
6884 INTRINSIC conjg, max
6886 LOGICAL LSIDE, NOCONJ, NOUNIT, UPPER
6887 INTEGER I, INFO, J, K, NROWA
6891 parameter( one = ( 1.0e+0, 0.0e+0 ) )
6893 parameter( zero = ( 0.0e+0, 0.0e+0 ) )
6899 lside = lsame( side ,
'L' )
6905 noconj = lsame( transa,
'T' )
6906 nounit = lsame( diag ,
'N' )
6907 upper = lsame( uplo ,
'U' )
6910 IF( ( .NOT.lside ).AND.
6911 $ ( .NOT.lsame( side ,
'R' ) ) )
THEN 6913 ELSE IF( ( .NOT.upper ).AND.
6914 $ ( .NOT.lsame( uplo ,
'L' ) ) )
THEN 6916 ELSE IF( ( .NOT.lsame( transa,
'N' ) ).AND.
6917 $ ( .NOT.lsame( transa,
'T' ) ).AND.
6918 $ ( .NOT.lsame( transa,
'C' ) ) )
THEN 6920 ELSE IF( ( .NOT.lsame( diag ,
'U' ) ).AND.
6921 $ ( .NOT.lsame( diag ,
'N' ) ) )
THEN 6923 ELSE IF( m .LT.0 )
THEN 6925 ELSE IF( n .LT.0 )
THEN 6927 ELSE IF( lda.LT.max( 1, nrowa ) )
THEN 6929 ELSE IF( ldb.LT.max( 1, m ) )
THEN 6933 CALL xerbla(
'CTRMM ', info )
6944 IF( alpha.EQ.zero )
THEN 6956 IF( lsame( transa,
'N' ) )
THEN 6963 IF( b( k, j ).NE.zero )
THEN 6964 temp = alpha*b( k, j )
6966 b( i, j ) = b( i, j ) + temp*a( i, k )
6969 $ temp = temp*a( k, k )
6977 IF( b( k, j ).NE.zero )
THEN 6978 temp = alpha*b( k, j )
6981 $ b( k, j ) = b( k, j )*a( k, k )
6983 b( i, j ) = b( i, j ) + temp*a( i, k )
6995 DO 110, i = m, 1, -1
6999 $ temp = temp*a( i, i )
7001 temp = temp + a( k, i )*b( k, j )
7005 $ temp = temp*conjg( a( i, i ) )
7006 DO 100, k = 1, i - 1
7007 temp = temp + conjg( a( k, i ) )*b( k, j )
7010 b( i, j ) = alpha*temp
7019 $ temp = temp*a( i, i )
7020 DO 130, k = i + 1, m
7021 temp = temp + a( k, i )*b( k, j )
7025 $ temp = temp*conjg( a( i, i ) )
7026 DO 140, k = i + 1, m
7027 temp = temp + conjg( a( k, i ) )*b( k, j )
7030 b( i, j ) = alpha*temp
7036 IF( lsame( transa,
'N' ) )
THEN 7041 DO 200, j = n, 1, -1
7044 $ temp = temp*a( j, j )
7046 b( i, j ) = temp*b( i, j )
7048 DO 190, k = 1, j - 1
7049 IF( a( k, j ).NE.zero )
THEN 7050 temp = alpha*a( k, j )
7052 b( i, j ) = b( i, j ) + temp*b( i, k )
7061 $ temp = temp*a( j, j )
7063 b( i, j ) = temp*b( i, j )
7065 DO 230, k = j + 1, n
7066 IF( a( k, j ).NE.zero )
THEN 7067 temp = alpha*a( k, j )
7069 b( i, j ) = b( i, j ) + temp*b( i, k )
7081 DO 260, j = 1, k - 1
7082 IF( a( j, k ).NE.zero )
THEN 7084 temp = alpha*a( j, k )
7086 temp = alpha*conjg( a( j, k ) )
7089 b( i, j ) = b( i, j ) + temp*b( i, k )
7096 temp = temp*a( k, k )
7098 temp = temp*conjg( a( k, k ) )
7101 IF( temp.NE.one )
THEN 7103 b( i, k ) = temp*b( i, k )
7108 DO 320, k = n, 1, -1
7109 DO 300, j = k + 1, n
7110 IF( a( j, k ).NE.zero )
THEN 7112 temp = alpha*a( j, k )
7114 temp = alpha*conjg( a( j, k ) )
7117 b( i, j ) = b( i, j ) + temp*b( i, k )
7124 temp = temp*a( k, k )
7126 temp = temp*conjg( a( k, k ) )
7129 IF( temp.NE.one )
THEN 7131 b( i, k ) = temp*b( i, k )
7144 SUBROUTINE ctrmv ( UPLO, TRANS, DIAG, N, A, LDA, X, INCX )
7146 INTEGER INCX, LDA, N
7147 CHARACTER*1 DIAG, TRANS, UPLO
7149 COMPLEX A( lda, * ), X( * )
7245 parameter( zero = ( 0.0e+0, 0.0e+0 ) )
7248 INTEGER I, INFO, IX, J, JX, KX
7249 LOGICAL NOCONJ, NOUNIT
7256 INTRINSIC conjg, max
7263 IF ( .NOT.lsame( uplo ,
'U' ).AND.
7264 $ .NOT.lsame( uplo ,
'L' ) )
THEN 7266 ELSE IF( .NOT.lsame( trans,
'N' ).AND.
7267 $ .NOT.lsame( trans,
'T' ).AND.
7268 $ .NOT.lsame( trans,
'C' ) )
THEN 7270 ELSE IF( .NOT.lsame( diag ,
'U' ).AND.
7271 $ .NOT.lsame( diag ,
'N' ) )
THEN 7273 ELSE IF( n.LT.0 )
THEN 7275 ELSE IF( lda.LT.max( 1, n ) )
THEN 7277 ELSE IF( incx.EQ.0 )
THEN 7281 CALL xerbla(
'CTRMV ', info )
7290 noconj = lsame( trans,
'T' )
7291 nounit = lsame( diag ,
'N' )
7297 kx = 1 - ( n - 1 )*incx
7298 ELSE IF( incx.NE.1 )
THEN 7305 IF( lsame( trans,
'N' ) )
THEN 7309 IF( lsame( uplo,
'U' ) )
THEN 7312 IF( x( j ).NE.zero )
THEN 7315 x( i ) = x( i ) + temp*a( i, j )
7318 $ x( j ) = x( j )*a( j, j )
7324 IF( x( jx ).NE.zero )
THEN 7328 x( ix ) = x( ix ) + temp*a( i, j )
7332 $ x( jx ) = x( jx )*a( j, j )
7340 IF( x( j ).NE.zero )
THEN 7342 DO 50, i = n, j + 1, -1
7343 x( i ) = x( i ) + temp*a( i, j )
7346 $ x( j ) = x( j )*a( j, j )
7350 kx = kx + ( n - 1 )*incx
7353 IF( x( jx ).NE.zero )
THEN 7356 DO 70, i = n, j + 1, -1
7357 x( ix ) = x( ix ) + temp*a( i, j )
7361 $ x( jx ) = x( jx )*a( j, j )
7371 IF( lsame( uplo,
'U' ) )
THEN 7373 DO 110, j = n, 1, -1
7377 $ temp = temp*a( j, j )
7378 DO 90, i = j - 1, 1, -1
7379 temp = temp + a( i, j )*x( i )
7383 $ temp = temp*conjg( a( j, j ) )
7384 DO 100, i = j - 1, 1, -1
7385 temp = temp + conjg( a( i, j ) )*x( i )
7391 jx = kx + ( n - 1 )*incx
7392 DO 140, j = n, 1, -1
7397 $ temp = temp*a( j, j )
7398 DO 120, i = j - 1, 1, -1
7400 temp = temp + a( i, j )*x( ix )
7404 $ temp = temp*conjg( a( j, j ) )
7405 DO 130, i = j - 1, 1, -1
7407 temp = temp + conjg( a( i, j ) )*x( ix )
7420 $ temp = temp*a( j, j )
7421 DO 150, i = j + 1, n
7422 temp = temp + a( i, j )*x( i )
7426 $ temp = temp*conjg( a( j, j ) )
7427 DO 160, i = j + 1, n
7428 temp = temp + conjg( a( i, j ) )*x( i )
7440 $ temp = temp*a( j, j )
7441 DO 180, i = j + 1, n
7443 temp = temp + a( i, j )*x( ix )
7447 $ temp = temp*conjg( a( j, j ) )
7448 DO 190, i = j + 1, n
7450 temp = temp + conjg( a( i, j ) )*x( ix )
7465 SUBROUTINE ctrsm ( SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA,
7468 CHARACTER*1 SIDE, UPLO, TRANSA, DIAG
7469 INTEGER M, N, LDA, LDB
7472 COMPLEX A( lda, * ), B( ldb, * )
7599 INTRINSIC conjg, max
7601 LOGICAL LSIDE, NOCONJ, NOUNIT, UPPER
7602 INTEGER I, INFO, J, K, NROWA
7606 parameter( one = ( 1.0e+0, 0.0e+0 ) )
7608 parameter( zero = ( 0.0e+0, 0.0e+0 ) )
7614 lside = lsame( side ,
'L' )
7620 noconj = lsame( transa,
'T' )
7621 nounit = lsame( diag ,
'N' )
7622 upper = lsame( uplo ,
'U' )
7625 IF( ( .NOT.lside ).AND.
7626 $ ( .NOT.lsame( side ,
'R' ) ) )
THEN 7628 ELSE IF( ( .NOT.upper ).AND.
7629 $ ( .NOT.lsame( uplo ,
'L' ) ) )
THEN 7631 ELSE IF( ( .NOT.lsame( transa,
'N' ) ).AND.
7632 $ ( .NOT.lsame( transa,
'T' ) ).AND.
7633 $ ( .NOT.lsame( transa,
'C' ) ) )
THEN 7635 ELSE IF( ( .NOT.lsame( diag ,
'U' ) ).AND.
7636 $ ( .NOT.lsame( diag ,
'N' ) ) )
THEN 7638 ELSE IF( m .LT.0 )
THEN 7640 ELSE IF( n .LT.0 )
THEN 7642 ELSE IF( lda.LT.max( 1, nrowa ) )
THEN 7644 ELSE IF( ldb.LT.max( 1, m ) )
THEN 7648 CALL xerbla(
'CTRSM ', info )
7659 IF( alpha.EQ.zero )
THEN 7671 IF( lsame( transa,
'N' ) )
THEN 7677 IF( alpha.NE.one )
THEN 7679 b( i, j ) = alpha*b( i, j )
7683 IF( b( k, j ).NE.zero )
THEN 7685 $ b( k, j ) = b( k, j )/a( k, k )
7687 b( i, j ) = b( i, j ) - b( k, j )*a( i, k )
7694 IF( alpha.NE.one )
THEN 7696 b( i, j ) = alpha*b( i, j )
7700 IF( b( k, j ).NE.zero )
THEN 7702 $ b( k, j ) = b( k, j )/a( k, k )
7704 b( i, j ) = b( i, j ) - b( k, j )*a( i, k )
7718 temp = alpha*b( i, j )
7720 DO 110, k = 1, i - 1
7721 temp = temp - a( k, i )*b( k, j )
7724 $ temp = temp/a( i, i )
7726 DO 120, k = 1, i - 1
7727 temp = temp - conjg( a( k, i ) )*b( k, j )
7730 $ temp = temp/conjg( a( i, i ) )
7737 DO 170, i = m, 1, -1
7738 temp = alpha*b( i, j )
7740 DO 150, k = i + 1, m
7741 temp = temp - a( k, i )*b( k, j )
7744 $ temp = temp/a( i, i )
7746 DO 160, k = i + 1, m
7747 temp = temp - conjg( a( k, i ) )*b( k, j )
7750 $ temp = temp/conjg( a( i, i ) )
7758 IF( lsame( transa,
'N' ) )
THEN 7764 IF( alpha.NE.one )
THEN 7766 b( i, j ) = alpha*b( i, j )
7769 DO 210, k = 1, j - 1
7770 IF( a( k, j ).NE.zero )
THEN 7772 b( i, j ) = b( i, j ) - a( k, j )*b( i, k )
7777 temp = one/a( j, j )
7779 b( i, j ) = temp*b( i, j )
7784 DO 280, j = n, 1, -1
7785 IF( alpha.NE.one )
THEN 7787 b( i, j ) = alpha*b( i, j )
7790 DO 260, k = j + 1, n
7791 IF( a( k, j ).NE.zero )
THEN 7793 b( i, j ) = b( i, j ) - a( k, j )*b( i, k )
7798 temp = one/a( j, j )
7800 b( i, j ) = temp*b( i, j )
7811 DO 330, k = n, 1, -1
7814 temp = one/a( k, k )
7816 temp = one/conjg( a( k, k ) )
7819 b( i, k ) = temp*b( i, k )
7822 DO 310, j = 1, k - 1
7823 IF( a( j, k ).NE.zero )
THEN 7827 temp = conjg( a( j, k ) )
7830 b( i, j ) = b( i, j ) - temp*b( i, k )
7834 IF( alpha.NE.one )
THEN 7836 b( i, k ) = alpha*b( i, k )
7844 temp = one/a( k, k )
7846 temp = one/conjg( a( k, k ) )
7849 b( i, k ) = temp*b( i, k )
7852 DO 360, j = k + 1, n
7853 IF( a( j, k ).NE.zero )
THEN 7857 temp = conjg( a( j, k ) )
7860 b( i, j ) = b( i, j ) - temp*b( i, k )
7864 IF( alpha.NE.one )
THEN 7866 b( i, k ) = alpha*b( i, k )
7879 SUBROUTINE ctrsv ( UPLO, TRANS, DIAG, N, A, LDA, X, INCX )
7881 INTEGER INCX, LDA, N
7882 CHARACTER*1 DIAG, TRANS, UPLO
7884 COMPLEX A( lda, * ), X( * )
7983 parameter( zero = ( 0.0e+0, 0.0e+0 ) )
7986 INTEGER I, INFO, IX, J, JX, KX
7987 LOGICAL NOCONJ, NOUNIT
7994 INTRINSIC conjg, max
8001 IF ( .NOT.lsame( uplo ,
'U' ).AND.
8002 $ .NOT.lsame( uplo ,
'L' ) )
THEN 8004 ELSE IF( .NOT.lsame( trans,
'N' ).AND.
8005 $ .NOT.lsame( trans,
'T' ).AND.
8006 $ .NOT.lsame( trans,
'C' ) )
THEN 8008 ELSE IF( .NOT.lsame( diag ,
'U' ).AND.
8009 $ .NOT.lsame( diag ,
'N' ) )
THEN 8011 ELSE IF( n.LT.0 )
THEN 8013 ELSE IF( lda.LT.max( 1, n ) )
THEN 8015 ELSE IF( incx.EQ.0 )
THEN 8019 CALL xerbla(
'CTRSV ', info )
8028 noconj = lsame( trans,
'T' )
8029 nounit = lsame( diag ,
'N' )
8035 kx = 1 - ( n - 1 )*incx
8036 ELSE IF( incx.NE.1 )
THEN 8043 IF( lsame( trans,
'N' ) )
THEN 8047 IF( lsame( uplo,
'U' ) )
THEN 8050 IF( x( j ).NE.zero )
THEN 8052 $ x( j ) = x( j )/a( j, j )
8054 DO 10, i = j - 1, 1, -1
8055 x( i ) = x( i ) - temp*a( i, j )
8060 jx = kx + ( n - 1 )*incx
8062 IF( x( jx ).NE.zero )
THEN 8064 $ x( jx ) = x( jx )/a( j, j )
8067 DO 30, i = j - 1, 1, -1
8069 x( ix ) = x( ix ) - temp*a( i, j )
8078 IF( x( j ).NE.zero )
THEN 8080 $ x( j ) = x( j )/a( j, j )
8083 x( i ) = x( i ) - temp*a( i, j )
8090 IF( x( jx ).NE.zero )
THEN 8092 $ x( jx ) = x( jx )/a( j, j )
8097 x( ix ) = x( ix ) - temp*a( i, j )
8108 IF( lsame( uplo,
'U' ) )
THEN 8114 temp = temp - a( i, j )*x( i )
8117 $ temp = temp/a( j, j )
8119 DO 100, i = 1, j - 1
8120 temp = temp - conjg( a( i, j ) )*x( i )
8123 $ temp = temp/conjg( a( j, j ) )
8133 DO 120, i = 1, j - 1
8134 temp = temp - a( i, j )*x( ix )
8138 $ temp = temp/a( j, j )
8140 DO 130, i = 1, j - 1
8141 temp = temp - conjg( a( i, j ) )*x( ix )
8145 $ temp = temp/conjg( a( j, j ) )
8153 DO 170, j = n, 1, -1
8156 DO 150, i = n, j + 1, -1
8157 temp = temp - a( i, j )*x( i )
8160 $ temp = temp/a( j, j )
8162 DO 160, i = n, j + 1, -1
8163 temp = temp - conjg( a( i, j ) )*x( i )
8166 $ temp = temp/conjg( a( j, j ) )
8171 kx = kx + ( n - 1 )*incx
8173 DO 200, j = n, 1, -1
8177 DO 180, i = n, j + 1, -1
8178 temp = temp - a( i, j )*x( ix )
8182 $ temp = temp/a( j, j )
8184 DO 190, i = n, j + 1, -1
8185 temp = temp - conjg( a( i, j ) )*x( ix )
8189 $ temp = temp/conjg( a( j, j ) )
8203 double precision function dasum(n,dx,incx)
8210 double precision dx(*),dtemp
8211 integer i,incx,m,mp1,n,nincx
8215 if( n.le.0 .or. incx.le.0 )
return 8216 if(incx.eq.1)
go to 20
8221 do 10 i = 1,nincx,incx
8222 dtemp = dtemp + dabs(dx(i))
8233 if( m .eq. 0 )
go to 40
8235 dtemp = dtemp + dabs(dx(i))
8237 if( n .lt. 6 )
go to 60
8240 dtemp = dtemp + dabs(dx(i)) + dabs(dx(i + 1)) + dabs(dx(i + 2))
8241 * + dabs(dx(i + 3)) + dabs(dx(i + 4)) + dabs(dx(i + 5))
8246 subroutine daxpy(n,da,dx,incx,dy,incy)
8253 double precision dx(*),dy(*),da
8254 integer i,incx,incy,ix,iy,m,mp1,n
8257 if (da .eq. 0.0d0)
return 8258 if(incx.eq.1.and.incy.eq.1)
go to 20
8265 if(incx.lt.0)ix = (-n+1)*incx + 1
8266 if(incy.lt.0)iy = (-n+1)*incy + 1
8268 dy(iy) = dy(iy) + da*dx(ix)
8280 if( m .eq. 0 )
go to 40
8282 dy(i) = dy(i) + da*dx(i)
8284 if( n .lt. 4 )
return 8287 dy(i) = dy(i) + da*dx(i)
8288 dy(i + 1) = dy(i + 1) + da*dx(i + 1)
8289 dy(i + 2) = dy(i + 2) + da*dx(i + 2)
8290 dy(i + 3) = dy(i + 3) + da*dx(i + 3)
8294 double precision function dcabs1(z)
8296 double precision t(2)
8297 equivalence(zz,t(1))
8299 dcabs1 = dabs(t(1)) + dabs(t(2))
8302 subroutine dcopy(n,dx,incx,dy,incy)
8309 double precision dx(*),dy(*)
8310 integer i,incx,incy,ix,iy,m,mp1,n
8313 if(incx.eq.1.and.incy.eq.1)
go to 20
8320 if(incx.lt.0)ix = (-n+1)*incx + 1
8321 if(incy.lt.0)iy = (-n+1)*incy + 1
8335 if( m .eq. 0 )
go to 40
8339 if( n .lt. 7 )
return 8343 dy(i + 1) = dx(i + 1)
8344 dy(i + 2) = dx(i + 2)
8345 dy(i + 3) = dx(i + 3)
8346 dy(i + 4) = dx(i + 4)
8347 dy(i + 5) = dx(i + 5)
8348 dy(i + 6) = dx(i + 6)
8352 double precision function ddot(n,dx,incx,dy,incy)
8359 double precision dx(*),dy(*),dtemp
8360 integer i,incx,incy,ix,iy,m,mp1,n
8365 if(incx.eq.1.and.incy.eq.1)
go to 20
8372 if(incx.lt.0)ix = (-n+1)*incx + 1
8373 if(incy.lt.0)iy = (-n+1)*incy + 1
8375 dtemp = dtemp + dx(ix)*dy(iy)
8388 if( m .eq. 0 )
go to 40
8390 dtemp = dtemp + dx(i)*dy(i)
8392 if( n .lt. 5 )
go to 60
8395 dtemp = dtemp + dx(i)*dy(i) + dx(i + 1)*dy(i + 1) +
8396 * dx(i + 2)*dy(i + 2) + dx(i + 3)*dy(i + 3) + dx(i + 4)*dy(i + 4)
8401 SUBROUTINE dgbmv ( TRANS, M, N, KL, KU, ALPHA, A, LDA, X, INCX,
8404 DOUBLE PRECISION ALPHA, BETA
8405 INTEGER INCX, INCY, KL, KU, LDA, M, N
8408 DOUBLE PRECISION A( lda, * ), X( * ), Y( * )
8528 DOUBLE PRECISION ONE , ZERO
8529 parameter( one = 1.0d+0, zero = 0.0d+0 )
8531 DOUBLE PRECISION TEMP
8532 INTEGER I, INFO, IX, IY, J, JX, JY, K, KUP1, KX, KY,
8547 IF ( .NOT.lsame( trans,
'N' ).AND.
8548 $ .NOT.lsame( trans,
'T' ).AND.
8549 $ .NOT.lsame( trans,
'C' ) )
THEN 8551 ELSE IF( m.LT.0 )
THEN 8553 ELSE IF( n.LT.0 )
THEN 8555 ELSE IF( kl.LT.0 )
THEN 8557 ELSE IF( ku.LT.0 )
THEN 8559 ELSE IF( lda.LT.( kl + ku + 1 ) )
THEN 8561 ELSE IF( incx.EQ.0 )
THEN 8563 ELSE IF( incy.EQ.0 )
THEN 8567 CALL xerbla(
'DGBMV ', info )
8573 IF( ( m.EQ.0 ).OR.( n.EQ.0 ).OR.
8574 $ ( ( alpha.EQ.zero ).AND.( beta.EQ.one ) ) )
8580 IF( lsame( trans,
'N' ) )
THEN 8590 kx = 1 - ( lenx - 1 )*incx
8595 ky = 1 - ( leny - 1 )*incy
8603 IF( beta.NE.one )
THEN 8605 IF( beta.EQ.zero )
THEN 8611 y( i ) = beta*y( i )
8616 IF( beta.EQ.zero )
THEN 8623 y( iy ) = beta*y( iy )
8632 IF( lsame( trans,
'N' ) )
THEN 8639 IF( x( jx ).NE.zero )
THEN 8640 temp = alpha*x( jx )
8642 DO 50, i = max( 1, j - ku ), min( m, j + kl )
8643 y( i ) = y( i ) + temp*a( k + i, j )
8650 IF( x( jx ).NE.zero )
THEN 8651 temp = alpha*x( jx )
8654 DO 70, i = max( 1, j - ku ), min( m, j + kl )
8655 y( iy ) = y( iy ) + temp*a( k + i, j )
8673 DO 90, i = max( 1, j - ku ), min( m, j + kl )
8674 temp = temp + a( k + i, j )*x( i )
8676 y( jy ) = y( jy ) + alpha*temp
8684 DO 110, i = max( 1, j - ku ), min( m, j + kl )
8685 temp = temp + a( k + i, j )*x( ix )
8688 y( jy ) = y( jy ) + alpha*temp
8701 SUBROUTINE dgemm ( TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB,
8704 CHARACTER*1 TRANSA, TRANSB
8705 INTEGER M, N, K, LDA, LDB, LDC
8706 DOUBLE PRECISION ALPHA, BETA
8708 DOUBLE PRECISION A( lda, * ), B( ldb, * ), C( ldc, * )
8840 INTEGER I, INFO, J, L, NCOLA, NROWA, NROWB
8841 DOUBLE PRECISION TEMP
8843 DOUBLE PRECISION ONE , ZERO
8844 parameter( one = 1.0d+0, zero = 0.0d+0 )
8852 nota = lsame( transa,
'N' )
8853 notb = lsame( transb,
'N' )
8870 IF( ( .NOT.nota ).AND.
8871 $ ( .NOT.lsame( transa,
'C' ) ).AND.
8872 $ ( .NOT.lsame( transa,
'T' ) ) )
THEN 8874 ELSE IF( ( .NOT.notb ).AND.
8875 $ ( .NOT.lsame( transb,
'C' ) ).AND.
8876 $ ( .NOT.lsame( transb,
'T' ) ) )
THEN 8878 ELSE IF( m .LT.0 )
THEN 8880 ELSE IF( n .LT.0 )
THEN 8882 ELSE IF( k .LT.0 )
THEN 8884 ELSE IF( lda.LT.max( 1, nrowa ) )
THEN 8886 ELSE IF( ldb.LT.max( 1, nrowb ) )
THEN 8888 ELSE IF( ldc.LT.max( 1, m ) )
THEN 8892 CALL xerbla(
'DGEMM ', info )
8898 IF( ( m.EQ.0 ).OR.( n.EQ.0 ).OR.
8899 $ ( ( ( alpha.EQ.zero ).OR.( k.EQ.0 ) ).AND.( beta.EQ.one ) ) )
8904 IF( alpha.EQ.zero )
THEN 8905 IF( beta.EQ.zero )
THEN 8914 c( i, j ) = beta*c( i, j )
8929 IF( beta.EQ.zero )
THEN 8933 ELSE IF( beta.NE.one )
THEN 8935 c( i, j ) = beta*c( i, j )
8939 IF( b( l, j ).NE.zero )
THEN 8940 temp = alpha*b( l, j )
8942 c( i, j ) = c( i, j ) + temp*a( i, l )
8955 temp = temp + a( l, i )*b( l, j )
8957 IF( beta.EQ.zero )
THEN 8958 c( i, j ) = alpha*temp
8960 c( i, j ) = alpha*temp + beta*c( i, j )
8971 IF( beta.EQ.zero )
THEN 8975 ELSE IF( beta.NE.one )
THEN 8977 c( i, j ) = beta*c( i, j )
8981 IF( b( j, l ).NE.zero )
THEN 8982 temp = alpha*b( j, l )
8984 c( i, j ) = c( i, j ) + temp*a( i, l )
8997 temp = temp + a( l, i )*b( j, l )
8999 IF( beta.EQ.zero )
THEN 9000 c( i, j ) = alpha*temp
9002 c( i, j ) = alpha*temp + beta*c( i, j )
9014 SUBROUTINE dgemv ( TRANS, M, N, ALPHA, A, LDA, X, INCX,
9017 DOUBLE PRECISION ALPHA, BETA
9018 INTEGER INCX, INCY, LDA, M, N
9021 DOUBLE PRECISION A( lda, * ), X( * ), Y( * )
9116 DOUBLE PRECISION ONE , ZERO
9117 parameter( one = 1.0d+0, zero = 0.0d+0 )
9119 DOUBLE PRECISION TEMP
9120 INTEGER I, INFO, IX, IY, J, JX, JY, KX, KY, LENX, LENY
9134 IF ( .NOT.lsame( trans,
'N' ).AND.
9135 $ .NOT.lsame( trans,
'T' ).AND.
9136 $ .NOT.lsame( trans,
'C' ) )
THEN 9138 ELSE IF( m.LT.0 )
THEN 9140 ELSE IF( n.LT.0 )
THEN 9142 ELSE IF( lda.LT.max( 1, m ) )
THEN 9144 ELSE IF( incx.EQ.0 )
THEN 9146 ELSE IF( incy.EQ.0 )
THEN 9150 CALL xerbla(
'DGEMV ', info )
9156 IF( ( m.EQ.0 ).OR.( n.EQ.0 ).OR.
9157 $ ( ( alpha.EQ.zero ).AND.( beta.EQ.one ) ) )
9163 IF( lsame( trans,
'N' ) )
THEN 9173 kx = 1 - ( lenx - 1 )*incx
9178 ky = 1 - ( leny - 1 )*incy
9186 IF( beta.NE.one )
THEN 9188 IF( beta.EQ.zero )
THEN 9194 y( i ) = beta*y( i )
9199 IF( beta.EQ.zero )
THEN 9206 y( iy ) = beta*y( iy )
9214 IF( lsame( trans,
'N' ) )
THEN 9221 IF( x( jx ).NE.zero )
THEN 9222 temp = alpha*x( jx )
9224 y( i ) = y( i ) + temp*a( i, j )
9231 IF( x( jx ).NE.zero )
THEN 9232 temp = alpha*x( jx )
9235 y( iy ) = y( iy ) + temp*a( i, j )
9251 temp = temp + a( i, j )*x( i )
9253 y( jy ) = y( jy ) + alpha*temp
9261 temp = temp + a( i, j )*x( ix )
9264 y( jy ) = y( jy ) + alpha*temp
9275 SUBROUTINE dger ( M, N, ALPHA, X, INCX, Y, INCY, A, LDA )
9277 DOUBLE PRECISION ALPHA
9278 INTEGER INCX, INCY, LDA, M, N
9280 DOUBLE PRECISION A( lda, * ), X( * ), Y( * )
9354 DOUBLE PRECISION ZERO
9355 parameter( zero = 0.0d+0 )
9357 DOUBLE PRECISION TEMP
9358 INTEGER I, INFO, IX, J, JY, KX
9371 ELSE IF( n.LT.0 )
THEN 9373 ELSE IF( incx.EQ.0 )
THEN 9375 ELSE IF( incy.EQ.0 )
THEN 9377 ELSE IF( lda.LT.max( 1, m ) )
THEN 9381 CALL xerbla(
'DGER ', info )
9387 IF( ( m.EQ.0 ).OR.( n.EQ.0 ).OR.( alpha.EQ.zero ) )
9396 jy = 1 - ( n - 1 )*incy
9400 IF( y( jy ).NE.zero )
THEN 9401 temp = alpha*y( jy )
9403 a( i, j ) = a( i, j ) + x( i )*temp
9412 kx = 1 - ( m - 1 )*incx
9415 IF( y( jy ).NE.zero )
THEN 9416 temp = alpha*y( jy )
9419 a( i, j ) = a( i, j ) + x( ix )*temp
9432 DOUBLE PRECISION FUNCTION dnrm2 ( N, X, INCX )
9436 DOUBLE PRECISION X( * )
9452 DOUBLE PRECISION ONE , ZERO
9453 parameter( one = 1.0d+0, zero = 0.0d+0 )
9456 DOUBLE PRECISION ABSXI, NORM, SCALE, SSQ
9461 IF( n.LT.1 .OR. incx.LT.1 )
THEN 9463 ELSE IF( n.EQ.1 )
THEN 9464 norm = abs( x( 1 ) )
9472 DO 10, ix = 1, 1 + ( n - 1 )*incx, incx
9473 IF( x( ix ).NE.zero )
THEN 9474 absxi = abs( x( ix ) )
9475 IF( scale.LT.absxi )
THEN 9476 ssq = one + ssq*( scale/absxi )**2
9479 ssq = ssq + ( absxi/scale )**2
9483 norm = scale * sqrt( ssq )
9492 subroutine drot (n,dx,incx,dy,incy,c,s)
9498 double precision dx(*),dy(*),dtemp,c,s
9499 integer i,incx,incy,ix,iy,n
9502 if(incx.eq.1.and.incy.eq.1)
go to 20
9509 if(incx.lt.0)ix = (-n+1)*incx + 1
9510 if(incy.lt.0)iy = (-n+1)*incy + 1
9512 dtemp = c*dx(ix) + s*dy(iy)
9513 dy(iy) = c*dy(iy) - s*dx(ix)
9523 dtemp = c*dx(i) + s*dy(i)
9524 dy(i) = c*dy(i) - s*dx(i)
9529 subroutine drotg(da,db,c,s)
9534 double precision da,db,c,s,roe,scale,r,z
9537 if( dabs(da) .gt. dabs(db) ) roe = da
9538 scale = dabs(da) + dabs(db)
9539 if( scale .ne. 0.0d0 )
go to 10
9545 10 r = scale*dsqrt((da/scale)**2 + (db/scale)**2)
9546 r = dsign(1.0d0,roe)*r
9550 if( dabs(da) .gt. dabs(db) ) z = s
9551 if( dabs(db) .ge. dabs(da) .and. c .ne. 0.0d0 ) z = 1.0d0/c
9556 SUBROUTINE drotm (N,DX,INCX,DY,INCY,DPARAM)
9574 DOUBLE PRECISION DFLAG,DH12,DH22,DX,TWO,Z,DH11,DH21,
9576 dimension dx(1),dy(1),dparam(5)
9577 DATA zero,two/0.d0,2.d0/
9580 IF(
n .LE. 0 .OR.(dflag+two.EQ.zero))
GO TO 140
9581 IF(.NOT.(incx.EQ.incy.AND. incx .GT.0))
GO TO 70
9588 DO 20
i=1,nsteps,incx
9598 DO 40
i=1,nsteps,incx
9610 DO 60
i=1,nsteps,incx
9620 IF(incx .LT. 0) kx=1+(1-
n)*incx
9621 IF(incy .LT. 0) ky=1+(1-
n)*incy
9656 dx(kx)=w*dh11+z*dh12
9657 dy(ky)=w*dh21+z*dh22
9664 SUBROUTINE drotmg (DD1,DD2,DX1,DY1,DPARAM)
9684 DOUBLE PRECISION GAM,ONE,RGAMSQ,DD2,DH11,DH21,DPARAM,DP2,
9685 1 dq2,du,dy1,zero,gamsq,dd1,dflag,dh12,dh22,dp1,dq1,
9689 DATA zero,one,two /0.d0,1.d0,2.d0/
9690 DATA gam,gamsq,rgamsq/4096.d0,16777216.d0,5.9604645d-8/
9691 IF(.NOT. dd1 .LT. zero)
GO TO 10
9697 IF(.NOT. dp2 .EQ. zero)
GO TO 20
9706 IF(.NOT. dabs(dq1) .GT. dabs(dq2))
GO TO 40
9712 IF(.NOT. du .LE. zero)
GO TO 30
9723 IF(.NOT. dq2 .LT. zero)
GO TO 50
9752 IF(.NOT. dflag .GE. zero)
GO TO 90
9754 IF(.NOT. dflag .EQ. zero)
GO TO 80
9764 GO TO igo,(120,150,180,210)
9768 IF(.NOT. dd1 .LE. rgamsq)
GO TO 130
9769 IF(dd1 .EQ. zero)
GO TO 160
9781 IF(.NOT. dd1 .GE. gamsq)
GO TO 160
9793 IF(.NOT. dabs(dd2) .LE. rgamsq)
GO TO 190
9794 IF(dd2 .EQ. zero)
GO TO 220
9805 IF(.NOT. dabs(dd2) .GE. gamsq)
GO TO 220
9815 IF(dflag)250,230,240
9833 SUBROUTINE dsbmv ( UPLO, N, K, ALPHA, A, LDA, X, INCX,
9836 DOUBLE PRECISION ALPHA, BETA
9837 INTEGER INCX, INCY, K, LDA, N
9840 DOUBLE PRECISION A( lda, * ), X( * ), Y( * )
9964 DOUBLE PRECISION ONE , ZERO
9965 parameter( one = 1.0d+0, zero = 0.0d+0 )
9967 DOUBLE PRECISION TEMP1, TEMP2
9968 INTEGER I, INFO, IX, IY, J, JX, JY, KPLUS1, KX, KY, L
9982 IF ( .NOT.lsame( uplo,
'U' ).AND.
9983 $ .NOT.lsame( uplo,
'L' ) )
THEN 9985 ELSE IF( n.LT.0 )
THEN 9987 ELSE IF( k.LT.0 )
THEN 9989 ELSE IF( lda.LT.( k + 1 ) )
THEN 9991 ELSE IF( incx.EQ.0 )
THEN 9993 ELSE IF( incy.EQ.0 )
THEN 9997 CALL xerbla(
'DSBMV ', info )
10003 IF( ( n.EQ.0 ).OR.( ( alpha.EQ.zero ).AND.( beta.EQ.one ) ) )
10008 IF( incx.GT.0 )
THEN 10011 kx = 1 - ( n - 1 )*incx
10013 IF( incy.GT.0 )
THEN 10016 ky = 1 - ( n - 1 )*incy
10024 IF( beta.NE.one )
THEN 10025 IF( incy.EQ.1 )
THEN 10026 IF( beta.EQ.zero )
THEN 10032 y( i ) = beta*y( i )
10037 IF( beta.EQ.zero )
THEN 10044 y( iy ) = beta*y( iy )
10050 IF( alpha.EQ.zero )
10052 IF( lsame( uplo,
'U' ) )
THEN 10057 IF( ( incx.EQ.1 ).AND.( incy.EQ.1 ) )
THEN 10059 temp1 = alpha*x( j )
10062 DO 50, i = max( 1, j - k ), j - 1
10063 y( i ) = y( i ) + temp1*a( l + i, j )
10064 temp2 = temp2 + a( l + i, j )*x( i )
10066 y( j ) = y( j ) + temp1*a( kplus1, j ) + alpha*temp2
10072 temp1 = alpha*x( jx )
10077 DO 70, i = max( 1, j - k ), j - 1
10078 y( iy ) = y( iy ) + temp1*a( l + i, j )
10079 temp2 = temp2 + a( l + i, j )*x( ix )
10083 y( jy ) = y( jy ) + temp1*a( kplus1, j ) + alpha*temp2
10096 IF( ( incx.EQ.1 ).AND.( incy.EQ.1 ) )
THEN 10098 temp1 = alpha*x( j )
10100 y( j ) = y( j ) + temp1*a( 1, j )
10102 DO 90, i = j + 1, min( n, j + k )
10103 y( i ) = y( i ) + temp1*a( l + i, j )
10104 temp2 = temp2 + a( l + i, j )*x( i )
10106 y( j ) = y( j ) + alpha*temp2
10112 temp1 = alpha*x( jx )
10114 y( jy ) = y( jy ) + temp1*a( 1, j )
10118 DO 110, i = j + 1, min( n, j + k )
10121 y( iy ) = y( iy ) + temp1*a( l + i, j )
10122 temp2 = temp2 + a( l + i, j )*x( ix )
10124 y( jy ) = y( jy ) + alpha*temp2
10136 subroutine dscal(n,da,dx,incx)
10144 double precision da,dx(*)
10145 integer i,incx,m,mp1,n,nincx
10147 if( n.le.0 .or. incx.le.0 )
return 10148 if(incx.eq.1)
go to 20
10153 do 10 i = 1,nincx,incx
10164 if( m .eq. 0 )
go to 40
10168 if( n .lt. 5 )
return 10172 dx(i + 1) = da*dx(i + 1)
10173 dx(i + 2) = da*dx(i + 2)
10174 dx(i + 3) = da*dx(i + 3)
10175 dx(i + 4) = da*dx(i + 4)
10180 DOUBLE PRECISION FUNCTION dsdot (N, SX, INCX, SY, INCY)
10229 IF (
n .LE. 0)
RETURN 10230 IF (incx.EQ.incy .AND. incx.GT.0)
GO TO 20
10236 IF (incx .LT. 0) kx = 1+(1-
n)*incx
10237 IF (incy .LT. 0) ky = 1+(1-
n)*incy
10248 DO 30
i = 1,ns,incx
10253 SUBROUTINE dspmv ( UPLO, N, ALPHA, AP, X, INCX, BETA, Y, INCY )
10255 DOUBLE PRECISION ALPHA, BETA
10256 INTEGER INCX, INCY, N
10259 DOUBLE PRECISION AP( * ), X( * ), Y( * )
10349 DOUBLE PRECISION ONE , ZERO
10350 parameter( one = 1.0d+0, zero = 0.0d+0 )
10352 DOUBLE PRECISION TEMP1, TEMP2
10353 INTEGER I, INFO, IX, IY, J, JX, JY, K, KK, KX, KY
10365 IF ( .NOT.lsame( uplo,
'U' ).AND.
10366 $ .NOT.lsame( uplo,
'L' ) )
THEN 10368 ELSE IF( n.LT.0 )
THEN 10370 ELSE IF( incx.EQ.0 )
THEN 10372 ELSE IF( incy.EQ.0 )
THEN 10375 IF( info.NE.0 )
THEN 10376 CALL xerbla(
'DSPMV ', info )
10382 IF( ( n.EQ.0 ).OR.( ( alpha.EQ.zero ).AND.( beta.EQ.one ) ) )
10387 IF( incx.GT.0 )
THEN 10390 kx = 1 - ( n - 1 )*incx
10392 IF( incy.GT.0 )
THEN 10395 ky = 1 - ( n - 1 )*incy
10403 IF( beta.NE.one )
THEN 10404 IF( incy.EQ.1 )
THEN 10405 IF( beta.EQ.zero )
THEN 10411 y( i ) = beta*y( i )
10416 IF( beta.EQ.zero )
THEN 10423 y( iy ) = beta*y( iy )
10429 IF( alpha.EQ.zero )
10432 IF( lsame( uplo,
'U' ) )
THEN 10436 IF( ( incx.EQ.1 ).AND.( incy.EQ.1 ) )
THEN 10438 temp1 = alpha*x( j )
10441 DO 50, i = 1, j - 1
10442 y( i ) = y( i ) + temp1*ap( k )
10443 temp2 = temp2 + ap( k )*x( i )
10446 y( j ) = y( j ) + temp1*ap( kk + j - 1 ) + alpha*temp2
10453 temp1 = alpha*x( jx )
10457 DO 70, k = kk, kk + j - 2
10458 y( iy ) = y( iy ) + temp1*ap( k )
10459 temp2 = temp2 + ap( k )*x( ix )
10463 y( jy ) = y( jy ) + temp1*ap( kk + j - 1 ) + alpha*temp2
10473 IF( ( incx.EQ.1 ).AND.( incy.EQ.1 ) )
THEN 10475 temp1 = alpha*x( j )
10477 y( j ) = y( j ) + temp1*ap( kk )
10479 DO 90, i = j + 1, n
10480 y( i ) = y( i ) + temp1*ap( k )
10481 temp2 = temp2 + ap( k )*x( i )
10484 y( j ) = y( j ) + alpha*temp2
10485 kk = kk + ( n - j + 1 )
10491 temp1 = alpha*x( jx )
10493 y( jy ) = y( jy ) + temp1*ap( kk )
10496 DO 110, k = kk + 1, kk + n - j
10499 y( iy ) = y( iy ) + temp1*ap( k )
10500 temp2 = temp2 + ap( k )*x( ix )
10502 y( jy ) = y( jy ) + alpha*temp2
10505 kk = kk + ( n - j + 1 )
10515 SUBROUTINE dspr2 ( UPLO, N, ALPHA, X, INCX, Y, INCY, AP )
10517 DOUBLE PRECISION ALPHA
10518 INTEGER INCX, INCY, N
10521 DOUBLE PRECISION AP( * ), X( * ), Y( * )
10609 DOUBLE PRECISION ZERO
10610 parameter( zero = 0.0d+0 )
10612 DOUBLE PRECISION TEMP1, TEMP2
10613 INTEGER I, INFO, IX, IY, J, JX, JY, K, KK, KX, KY
10625 IF ( .NOT.lsame( uplo,
'U' ).AND.
10626 $ .NOT.lsame( uplo,
'L' ) )
THEN 10628 ELSE IF( n.LT.0 )
THEN 10630 ELSE IF( incx.EQ.0 )
THEN 10632 ELSE IF( incy.EQ.0 )
THEN 10635 IF( info.NE.0 )
THEN 10636 CALL xerbla(
'DSPR2 ', info )
10642 IF( ( n.EQ.0 ).OR.( alpha.EQ.zero ) )
10648 IF( ( incx.NE.1 ).OR.( incy.NE.1 ) )
THEN 10649 IF( incx.GT.0 )
THEN 10652 kx = 1 - ( n - 1 )*incx
10654 IF( incy.GT.0 )
THEN 10657 ky = 1 - ( n - 1 )*incy
10667 IF( lsame( uplo,
'U' ) )
THEN 10671 IF( ( incx.EQ.1 ).AND.( incy.EQ.1 ) )
THEN 10673 IF( ( x( j ).NE.zero ).OR.( y( j ).NE.zero ) )
THEN 10674 temp1 = alpha*y( j )
10675 temp2 = alpha*x( j )
10678 ap( k ) = ap( k ) + x( i )*temp1 + y( i )*temp2
10686 IF( ( x( jx ).NE.zero ).OR.( y( jy ).NE.zero ) )
THEN 10687 temp1 = alpha*y( jy )
10688 temp2 = alpha*x( jx )
10691 DO 30, k = kk, kk + j - 1
10692 ap( k ) = ap( k ) + x( ix )*temp1 + y( iy )*temp2
10706 IF( ( incx.EQ.1 ).AND.( incy.EQ.1 ) )
THEN 10708 IF( ( x( j ).NE.zero ).OR.( y( j ).NE.zero ) )
THEN 10709 temp1 = alpha*y( j )
10710 temp2 = alpha*x( j )
10713 ap( k ) = ap( k ) + x( i )*temp1 + y( i )*temp2
10717 kk = kk + n - j + 1
10721 IF( ( x( jx ).NE.zero ).OR.( y( jy ).NE.zero ) )
THEN 10722 temp1 = alpha*y( jy )
10723 temp2 = alpha*x( jx )
10726 DO 70, k = kk, kk + n - j
10727 ap( k ) = ap( k ) + x( ix )*temp1 + y( iy )*temp2
10734 kk = kk + n - j + 1
10744 SUBROUTINE dspr ( UPLO, N, ALPHA, X, INCX, AP )
10746 DOUBLE PRECISION ALPHA
10750 DOUBLE PRECISION AP( * ), X( * )
10827 DOUBLE PRECISION ZERO
10828 parameter( zero = 0.0d+0 )
10830 DOUBLE PRECISION TEMP
10831 INTEGER I, INFO, IX, J, JX, K, KK, KX
10843 IF ( .NOT.lsame( uplo,
'U' ).AND.
10844 $ .NOT.lsame( uplo,
'L' ) )
THEN 10846 ELSE IF( n.LT.0 )
THEN 10848 ELSE IF( incx.EQ.0 )
THEN 10851 IF( info.NE.0 )
THEN 10852 CALL xerbla(
'DSPR ', info )
10858 IF( ( n.EQ.0 ).OR.( alpha.EQ.zero ) )
10863 IF( incx.LE.0 )
THEN 10864 kx = 1 - ( n - 1 )*incx
10865 ELSE IF( incx.NE.1 )
THEN 10873 IF( lsame( uplo,
'U' ) )
THEN 10877 IF( incx.EQ.1 )
THEN 10879 IF( x( j ).NE.zero )
THEN 10880 temp = alpha*x( j )
10883 ap( k ) = ap( k ) + x( i )*temp
10892 IF( x( jx ).NE.zero )
THEN 10893 temp = alpha*x( jx )
10895 DO 30, k = kk, kk + j - 1
10896 ap( k ) = ap( k ) + x( ix )*temp
10908 IF( incx.EQ.1 )
THEN 10910 IF( x( j ).NE.zero )
THEN 10911 temp = alpha*x( j )
10914 ap( k ) = ap( k ) + x( i )*temp
10918 kk = kk + n - j + 1
10923 IF( x( jx ).NE.zero )
THEN 10924 temp = alpha*x( jx )
10926 DO 70, k = kk, kk + n - j
10927 ap( k ) = ap( k ) + x( ix )*temp
10932 kk = kk + n - j + 1
10942 subroutine dswap (n,dx,incx,dy,incy)
10949 double precision dx(*),dy(*),dtemp
10950 integer i,incx,incy,ix,iy,m,mp1,n
10953 if(incx.eq.1.and.incy.eq.1)
go to 20
10960 if(incx.lt.0)ix = (-n+1)*incx + 1
10961 if(incy.lt.0)iy = (-n+1)*incy + 1
10977 if( m .eq. 0 )
go to 40
10983 if( n .lt. 3 )
return 10990 dx(i + 1) = dy(i + 1)
10993 dx(i + 2) = dy(i + 2)
10998 SUBROUTINE dsymm ( SIDE, UPLO, M, N, ALPHA, A, LDA, B, LDB,
11001 CHARACTER*1 SIDE, UPLO
11002 INTEGER M, N, LDA, LDB, LDC
11003 DOUBLE PRECISION ALPHA, BETA
11005 DOUBLE PRECISION A( lda, * ), B( ldb, * ), C( ldc, * )
11141 INTEGER I, INFO, J, K, NROWA
11142 DOUBLE PRECISION TEMP1, TEMP2
11144 DOUBLE PRECISION ONE , ZERO
11145 parameter( one = 1.0d+0, zero = 0.0d+0 )
11151 IF( lsame( side,
'L' ) )
THEN 11156 upper = lsame( uplo,
'U' )
11161 IF( ( .NOT.lsame( side,
'L' ) ).AND.
11162 $ ( .NOT.lsame( side,
'R' ) ) )
THEN 11164 ELSE IF( ( .NOT.upper ).AND.
11165 $ ( .NOT.lsame( uplo,
'L' ) ) )
THEN 11167 ELSE IF( m .LT.0 )
THEN 11169 ELSE IF( n .LT.0 )
THEN 11171 ELSE IF( lda.LT.max( 1, nrowa ) )
THEN 11173 ELSE IF( ldb.LT.max( 1, m ) )
THEN 11175 ELSE IF( ldc.LT.max( 1, m ) )
THEN 11178 IF( info.NE.0 )
THEN 11179 CALL xerbla(
'DSYMM ', info )
11185 IF( ( m.EQ.0 ).OR.( n.EQ.0 ).OR.
11186 $ ( ( alpha.EQ.zero ).AND.( beta.EQ.one ) ) )
11191 IF( alpha.EQ.zero )
THEN 11192 IF( beta.EQ.zero )
THEN 11201 c( i, j ) = beta*c( i, j )
11210 IF( lsame( side,
'L' ) )
THEN 11217 temp1 = alpha*b( i, j )
11219 DO 50, k = 1, i - 1
11220 c( k, j ) = c( k, j ) + temp1 *a( k, i )
11221 temp2 = temp2 + b( k, j )*a( k, i )
11223 IF( beta.EQ.zero )
THEN 11224 c( i, j ) = temp1*a( i, i ) + alpha*temp2
11226 c( i, j ) = beta *c( i, j ) +
11227 $ temp1*a( i, i ) + alpha*temp2
11233 DO 90, i = m, 1, -1
11234 temp1 = alpha*b( i, j )
11236 DO 80, k = i + 1, m
11237 c( k, j ) = c( k, j ) + temp1 *a( k, i )
11238 temp2 = temp2 + b( k, j )*a( k, i )
11240 IF( beta.EQ.zero )
THEN 11241 c( i, j ) = temp1*a( i, i ) + alpha*temp2
11243 c( i, j ) = beta *c( i, j ) +
11244 $ temp1*a( i, i ) + alpha*temp2
11254 temp1 = alpha*a( j, j )
11255 IF( beta.EQ.zero )
THEN 11257 c( i, j ) = temp1*b( i, j )
11261 c( i, j ) = beta*c( i, j ) + temp1*b( i, j )
11264 DO 140, k = 1, j - 1
11266 temp1 = alpha*a( k, j )
11268 temp1 = alpha*a( j, k )
11271 c( i, j ) = c( i, j ) + temp1*b( i, k )
11274 DO 160, k = j + 1, n
11276 temp1 = alpha*a( j, k )
11278 temp1 = alpha*a( k, j )
11281 c( i, j ) = c( i, j ) + temp1*b( i, k )
11292 SUBROUTINE dsymv ( UPLO, N, ALPHA, A, LDA, X, INCX,
11295 DOUBLE PRECISION ALPHA, BETA
11296 INTEGER INCX, INCY, LDA, N
11299 DOUBLE PRECISION A( lda, * ), X( * ), Y( * )
11392 DOUBLE PRECISION ONE , ZERO
11393 parameter( one = 1.0d+0, zero = 0.0d+0 )
11395 DOUBLE PRECISION TEMP1, TEMP2
11396 INTEGER I, INFO, IX, IY, J, JX, JY, KX, KY
11410 IF ( .NOT.lsame( uplo,
'U' ).AND.
11411 $ .NOT.lsame( uplo,
'L' ) )
THEN 11413 ELSE IF( n.LT.0 )
THEN 11415 ELSE IF( lda.LT.max( 1, n ) )
THEN 11417 ELSE IF( incx.EQ.0 )
THEN 11419 ELSE IF( incy.EQ.0 )
THEN 11422 IF( info.NE.0 )
THEN 11423 CALL xerbla(
'DSYMV ', info )
11429 IF( ( n.EQ.0 ).OR.( ( alpha.EQ.zero ).AND.( beta.EQ.one ) ) )
11434 IF( incx.GT.0 )
THEN 11437 kx = 1 - ( n - 1 )*incx
11439 IF( incy.GT.0 )
THEN 11442 ky = 1 - ( n - 1 )*incy
11451 IF( beta.NE.one )
THEN 11452 IF( incy.EQ.1 )
THEN 11453 IF( beta.EQ.zero )
THEN 11459 y( i ) = beta*y( i )
11464 IF( beta.EQ.zero )
THEN 11471 y( iy ) = beta*y( iy )
11477 IF( alpha.EQ.zero )
11479 IF( lsame( uplo,
'U' ) )
THEN 11483 IF( ( incx.EQ.1 ).AND.( incy.EQ.1 ) )
THEN 11485 temp1 = alpha*x( j )
11487 DO 50, i = 1, j - 1
11488 y( i ) = y( i ) + temp1*a( i, j )
11489 temp2 = temp2 + a( i, j )*x( i )
11491 y( j ) = y( j ) + temp1*a( j, j ) + alpha*temp2
11497 temp1 = alpha*x( jx )
11501 DO 70, i = 1, j - 1
11502 y( iy ) = y( iy ) + temp1*a( i, j )
11503 temp2 = temp2 + a( i, j )*x( ix )
11507 y( jy ) = y( jy ) + temp1*a( j, j ) + alpha*temp2
11516 IF( ( incx.EQ.1 ).AND.( incy.EQ.1 ) )
THEN 11518 temp1 = alpha*x( j )
11520 y( j ) = y( j ) + temp1*a( j, j )
11521 DO 90, i = j + 1, n
11522 y( i ) = y( i ) + temp1*a( i, j )
11523 temp2 = temp2 + a( i, j )*x( i )
11525 y( j ) = y( j ) + alpha*temp2
11531 temp1 = alpha*x( jx )
11533 y( jy ) = y( jy ) + temp1*a( j, j )
11536 DO 110, i = j + 1, n
11539 y( iy ) = y( iy ) + temp1*a( i, j )
11540 temp2 = temp2 + a( i, j )*x( ix )
11542 y( jy ) = y( jy ) + alpha*temp2
11554 SUBROUTINE dsyr2 ( UPLO, N, ALPHA, X, INCX, Y, INCY, A, LDA )
11556 DOUBLE PRECISION ALPHA
11557 INTEGER INCX, INCY, LDA, N
11560 DOUBLE PRECISION A( lda, * ), X( * ), Y( * )
11651 DOUBLE PRECISION ZERO
11652 parameter( zero = 0.0d+0 )
11654 DOUBLE PRECISION TEMP1, TEMP2
11655 INTEGER I, INFO, IX, IY, J, JX, JY, KX, KY
11669 IF ( .NOT.lsame( uplo,
'U' ).AND.
11670 $ .NOT.lsame( uplo,
'L' ) )
THEN 11672 ELSE IF( n.LT.0 )
THEN 11674 ELSE IF( incx.EQ.0 )
THEN 11676 ELSE IF( incy.EQ.0 )
THEN 11678 ELSE IF( lda.LT.max( 1, n ) )
THEN 11681 IF( info.NE.0 )
THEN 11682 CALL xerbla(
'DSYR2 ', info )
11688 IF( ( n.EQ.0 ).OR.( alpha.EQ.zero ) )
11694 IF( ( incx.NE.1 ).OR.( incy.NE.1 ) )
THEN 11695 IF( incx.GT.0 )
THEN 11698 kx = 1 - ( n - 1 )*incx
11700 IF( incy.GT.0 )
THEN 11703 ky = 1 - ( n - 1 )*incy
11713 IF( lsame( uplo,
'U' ) )
THEN 11717 IF( ( incx.EQ.1 ).AND.( incy.EQ.1 ) )
THEN 11719 IF( ( x( j ).NE.zero ).OR.( y( j ).NE.zero ) )
THEN 11720 temp1 = alpha*y( j )
11721 temp2 = alpha*x( j )
11723 a( i, j ) = a( i, j ) + x( i )*temp1 + y( i )*temp2
11729 IF( ( x( jx ).NE.zero ).OR.( y( jy ).NE.zero ) )
THEN 11730 temp1 = alpha*y( jy )
11731 temp2 = alpha*x( jx )
11735 a( i, j ) = a( i, j ) + x( ix )*temp1
11749 IF( ( incx.EQ.1 ).AND.( incy.EQ.1 ) )
THEN 11751 IF( ( x( j ).NE.zero ).OR.( y( j ).NE.zero ) )
THEN 11752 temp1 = alpha*y( j )
11753 temp2 = alpha*x( j )
11755 a( i, j ) = a( i, j ) + x( i )*temp1 + y( i )*temp2
11761 IF( ( x( jx ).NE.zero ).OR.( y( jy ).NE.zero ) )
THEN 11762 temp1 = alpha*y( jy )
11763 temp2 = alpha*x( jx )
11767 a( i, j ) = a( i, j ) + x( ix )*temp1
11784 SUBROUTINE dsyr2k( UPLO, TRANS, N, K, ALPHA, A, LDA, B, LDB,
11787 CHARACTER*1 UPLO, TRANS
11788 INTEGER N, K, LDA, LDB, LDC
11789 DOUBLE PRECISION ALPHA, BETA
11791 DOUBLE PRECISION A( lda, * ), B( ldb, * ), C( ldc, * )
11930 INTEGER I, INFO, J, L, NROWA
11931 DOUBLE PRECISION TEMP1, TEMP2
11933 DOUBLE PRECISION ONE , ZERO
11934 parameter( one = 1.0d+0, zero = 0.0d+0 )
11940 IF( lsame( trans,
'N' ) )
THEN 11945 upper = lsame( uplo,
'U' )
11948 IF( ( .NOT.upper ).AND.
11949 $ ( .NOT.lsame( uplo ,
'L' ) ) )
THEN 11951 ELSE IF( ( .NOT.lsame( trans,
'N' ) ).AND.
11952 $ ( .NOT.lsame( trans,
'T' ) ).AND.
11953 $ ( .NOT.lsame( trans,
'C' ) ) )
THEN 11955 ELSE IF( n .LT.0 )
THEN 11957 ELSE IF( k .LT.0 )
THEN 11959 ELSE IF( lda.LT.max( 1, nrowa ) )
THEN 11961 ELSE IF( ldb.LT.max( 1, nrowa ) )
THEN 11963 ELSE IF( ldc.LT.max( 1, n ) )
THEN 11966 IF( info.NE.0 )
THEN 11967 CALL xerbla(
'DSYR2K', info )
11974 $ ( ( ( alpha.EQ.zero ).OR.( k.EQ.0 ) ).AND.( beta.EQ.one ) ) )
11979 IF( alpha.EQ.zero )
THEN 11981 IF( beta.EQ.zero )
THEN 11990 c( i, j ) = beta*c( i, j )
11995 IF( beta.EQ.zero )
THEN 12004 c( i, j ) = beta*c( i, j )
12014 IF( lsame( trans,
'N' ) )
THEN 12020 IF( beta.EQ.zero )
THEN 12024 ELSE IF( beta.NE.one )
THEN 12026 c( i, j ) = beta*c( i, j )
12030 IF( ( a( j, l ).NE.zero ).OR.
12031 $ ( b( j, l ).NE.zero ) )
THEN 12032 temp1 = alpha*b( j, l )
12033 temp2 = alpha*a( j, l )
12035 c( i, j ) = c( i, j ) +
12036 $ a( i, l )*temp1 + b( i, l )*temp2
12043 IF( beta.EQ.zero )
THEN 12047 ELSE IF( beta.NE.one )
THEN 12049 c( i, j ) = beta*c( i, j )
12053 IF( ( a( j, l ).NE.zero ).OR.
12054 $ ( b( j, l ).NE.zero ) )
THEN 12055 temp1 = alpha*b( j, l )
12056 temp2 = alpha*a( j, l )
12058 c( i, j ) = c( i, j ) +
12059 $ a( i, l )*temp1 + b( i, l )*temp2
12075 temp1 = temp1 + a( l, i )*b( l, j )
12076 temp2 = temp2 + b( l, i )*a( l, j )
12078 IF( beta.EQ.zero )
THEN 12079 c( i, j ) = alpha*temp1 + alpha*temp2
12081 c( i, j ) = beta *c( i, j ) +
12082 $ alpha*temp1 + alpha*temp2
12092 temp1 = temp1 + a( l, i )*b( l, j )
12093 temp2 = temp2 + b( l, i )*a( l, j )
12095 IF( beta.EQ.zero )
THEN 12096 c( i, j ) = alpha*temp1 + alpha*temp2
12098 c( i, j ) = beta *c( i, j ) +
12099 $ alpha*temp1 + alpha*temp2
12111 SUBROUTINE dsyr ( UPLO, N, ALPHA, X, INCX, A, LDA )
12113 DOUBLE PRECISION ALPHA
12114 INTEGER INCX, LDA, N
12117 DOUBLE PRECISION A( lda, * ), X( * )
12197 DOUBLE PRECISION ZERO
12198 parameter( zero = 0.0d+0 )
12200 DOUBLE PRECISION TEMP
12201 INTEGER I, INFO, IX, J, JX, KX
12215 IF ( .NOT.lsame( uplo,
'U' ).AND.
12216 $ .NOT.lsame( uplo,
'L' ) )
THEN 12218 ELSE IF( n.LT.0 )
THEN 12220 ELSE IF( incx.EQ.0 )
THEN 12222 ELSE IF( lda.LT.max( 1, n ) )
THEN 12225 IF( info.NE.0 )
THEN 12226 CALL xerbla(
'DSYR ', info )
12232 IF( ( n.EQ.0 ).OR.( alpha.EQ.zero ) )
12237 IF( incx.LE.0 )
THEN 12238 kx = 1 - ( n - 1 )*incx
12239 ELSE IF( incx.NE.1 )
THEN 12247 IF( lsame( uplo,
'U' ) )
THEN 12251 IF( incx.EQ.1 )
THEN 12253 IF( x( j ).NE.zero )
THEN 12254 temp = alpha*x( j )
12256 a( i, j ) = a( i, j ) + x( i )*temp
12263 IF( x( jx ).NE.zero )
THEN 12264 temp = alpha*x( jx )
12267 a( i, j ) = a( i, j ) + x( ix )*temp
12278 IF( incx.EQ.1 )
THEN 12280 IF( x( j ).NE.zero )
THEN 12281 temp = alpha*x( j )
12283 a( i, j ) = a( i, j ) + x( i )*temp
12290 IF( x( jx ).NE.zero )
THEN 12291 temp = alpha*x( jx )
12294 a( i, j ) = a( i, j ) + x( ix )*temp
12308 SUBROUTINE dsyrk ( UPLO, TRANS, N, K, ALPHA, A, LDA,
12311 CHARACTER*1 UPLO, TRANS
12312 INTEGER N, K, LDA, LDC
12313 DOUBLE PRECISION ALPHA, BETA
12315 DOUBLE PRECISION A( lda, * ), C( ldc, * )
12435 INTEGER I, INFO, J, L, NROWA
12436 DOUBLE PRECISION TEMP
12438 DOUBLE PRECISION ONE , ZERO
12439 parameter( one = 1.0d+0, zero = 0.0d+0 )
12445 IF( lsame( trans,
'N' ) )
THEN 12450 upper = lsame( uplo,
'U' )
12453 IF( ( .NOT.upper ).AND.
12454 $ ( .NOT.lsame( uplo ,
'L' ) ) )
THEN 12456 ELSE IF( ( .NOT.lsame( trans,
'N' ) ).AND.
12457 $ ( .NOT.lsame( trans,
'T' ) ).AND.
12458 $ ( .NOT.lsame( trans,
'C' ) ) )
THEN 12460 ELSE IF( n .LT.0 )
THEN 12462 ELSE IF( k .LT.0 )
THEN 12464 ELSE IF( lda.LT.max( 1, nrowa ) )
THEN 12466 ELSE IF( ldc.LT.max( 1, n ) )
THEN 12469 IF( info.NE.0 )
THEN 12470 CALL xerbla(
'DSYRK ', info )
12477 $ ( ( ( alpha.EQ.zero ).OR.( k.EQ.0 ) ).AND.( beta.EQ.one ) ) )
12482 IF( alpha.EQ.zero )
THEN 12484 IF( beta.EQ.zero )
THEN 12493 c( i, j ) = beta*c( i, j )
12498 IF( beta.EQ.zero )
THEN 12507 c( i, j ) = beta*c( i, j )
12517 IF( lsame( trans,
'N' ) )
THEN 12523 IF( beta.EQ.zero )
THEN 12527 ELSE IF( beta.NE.one )
THEN 12529 c( i, j ) = beta*c( i, j )
12533 IF( a( j, l ).NE.zero )
THEN 12534 temp = alpha*a( j, l )
12536 c( i, j ) = c( i, j ) + temp*a( i, l )
12543 IF( beta.EQ.zero )
THEN 12547 ELSE IF( beta.NE.one )
THEN 12549 c( i, j ) = beta*c( i, j )
12553 IF( a( j, l ).NE.zero )
THEN 12554 temp = alpha*a( j, l )
12556 c( i, j ) = c( i, j ) + temp*a( i, l )
12571 temp = temp + a( l, i )*a( l, j )
12573 IF( beta.EQ.zero )
THEN 12574 c( i, j ) = alpha*temp
12576 c( i, j ) = alpha*temp + beta*c( i, j )
12585 temp = temp + a( l, i )*a( l, j )
12587 IF( beta.EQ.zero )
THEN 12588 c( i, j ) = alpha*temp
12590 c( i, j ) = alpha*temp + beta*c( i, j )
12602 SUBROUTINE dtbmv ( UPLO, TRANS, DIAG, N, K, A, LDA, X, INCX )
12604 INTEGER INCX, K, LDA, N
12605 CHARACTER*1 DIAG, TRANS, UPLO
12607 DOUBLE PRECISION A( lda, * ), X( * )
12739 DOUBLE PRECISION ZERO
12740 parameter( zero = 0.0d+0 )
12742 DOUBLE PRECISION TEMP
12743 INTEGER I, INFO, IX, J, JX, KPLUS1, KX, L
12758 IF ( .NOT.lsame( uplo ,
'U' ).AND.
12759 $ .NOT.lsame( uplo ,
'L' ) )
THEN 12761 ELSE IF( .NOT.lsame( trans,
'N' ).AND.
12762 $ .NOT.lsame( trans,
'T' ).AND.
12763 $ .NOT.lsame( trans,
'C' ) )
THEN 12765 ELSE IF( .NOT.lsame( diag ,
'U' ).AND.
12766 $ .NOT.lsame( diag ,
'N' ) )
THEN 12768 ELSE IF( n.LT.0 )
THEN 12770 ELSE IF( k.LT.0 )
THEN 12772 ELSE IF( lda.LT.( k + 1 ) )
THEN 12774 ELSE IF( incx.EQ.0 )
THEN 12777 IF( info.NE.0 )
THEN 12778 CALL xerbla(
'DTBMV ', info )
12787 nounit = lsame( diag,
'N' )
12792 IF( incx.LE.0 )
THEN 12793 kx = 1 - ( n - 1 )*incx
12794 ELSE IF( incx.NE.1 )
THEN 12801 IF( lsame( trans,
'N' ) )
THEN 12805 IF( lsame( uplo,
'U' ) )
THEN 12807 IF( incx.EQ.1 )
THEN 12809 IF( x( j ).NE.zero )
THEN 12812 DO 10, i = max( 1, j - k ), j - 1
12813 x( i ) = x( i ) + temp*a( l + i, j )
12816 $ x( j ) = x( j )*a( kplus1, j )
12822 IF( x( jx ).NE.zero )
THEN 12826 DO 30, i = max( 1, j - k ), j - 1
12827 x( ix ) = x( ix ) + temp*a( l + i, j )
12831 $ x( jx ) = x( jx )*a( kplus1, j )
12839 IF( incx.EQ.1 )
THEN 12840 DO 60, j = n, 1, -1
12841 IF( x( j ).NE.zero )
THEN 12844 DO 50, i = min( n, j + k ), j + 1, -1
12845 x( i ) = x( i ) + temp*a( l + i, j )
12848 $ x( j ) = x( j )*a( 1, j )
12852 kx = kx + ( n - 1 )*incx
12854 DO 80, j = n, 1, -1
12855 IF( x( jx ).NE.zero )
THEN 12859 DO 70, i = min( n, j + k ), j + 1, -1
12860 x( ix ) = x( ix ) + temp*a( l + i, j )
12864 $ x( jx ) = x( jx )*a( 1, j )
12867 IF( ( n - j ).GE.k )
12876 IF( lsame( uplo,
'U' ) )
THEN 12878 IF( incx.EQ.1 )
THEN 12879 DO 100, j = n, 1, -1
12883 $ temp = temp*a( kplus1, j )
12884 DO 90, i = j - 1, max( 1, j - k ), -1
12885 temp = temp + a( l + i, j )*x( i )
12890 kx = kx + ( n - 1 )*incx
12892 DO 120, j = n, 1, -1
12898 $ temp = temp*a( kplus1, j )
12899 DO 110, i = j - 1, max( 1, j - k ), -1
12900 temp = temp + a( l + i, j )*x( ix )
12908 IF( incx.EQ.1 )
THEN 12913 $ temp = temp*a( 1, j )
12914 DO 130, i = j + 1, min( n, j + k )
12915 temp = temp + a( l + i, j )*x( i )
12927 $ temp = temp*a( 1, j )
12928 DO 150, i = j + 1, min( n, j + k )
12929 temp = temp + a( l + i, j )*x( ix )
12944 SUBROUTINE dtbsv ( UPLO, TRANS, DIAG, N, K, A, LDA, X, INCX )
12946 INTEGER INCX, K, LDA, N
12947 CHARACTER*1 DIAG, TRANS, UPLO
12949 DOUBLE PRECISION A( lda, * ), X( * )
13085 DOUBLE PRECISION ZERO
13086 parameter( zero = 0.0d+0 )
13088 DOUBLE PRECISION TEMP
13089 INTEGER I, INFO, IX, J, JX, KPLUS1, KX, L
13104 IF ( .NOT.lsame( uplo ,
'U' ).AND.
13105 $ .NOT.lsame( uplo ,
'L' ) )
THEN 13107 ELSE IF( .NOT.lsame( trans,
'N' ).AND.
13108 $ .NOT.lsame( trans,
'T' ).AND.
13109 $ .NOT.lsame( trans,
'C' ) )
THEN 13111 ELSE IF( .NOT.lsame( diag ,
'U' ).AND.
13112 $ .NOT.lsame( diag ,
'N' ) )
THEN 13114 ELSE IF( n.LT.0 )
THEN 13116 ELSE IF( k.LT.0 )
THEN 13118 ELSE IF( lda.LT.( k + 1 ) )
THEN 13120 ELSE IF( incx.EQ.0 )
THEN 13123 IF( info.NE.0 )
THEN 13124 CALL xerbla(
'DTBSV ', info )
13133 nounit = lsame( diag,
'N' )
13138 IF( incx.LE.0 )
THEN 13139 kx = 1 - ( n - 1 )*incx
13140 ELSE IF( incx.NE.1 )
THEN 13147 IF( lsame( trans,
'N' ) )
THEN 13151 IF( lsame( uplo,
'U' ) )
THEN 13153 IF( incx.EQ.1 )
THEN 13154 DO 20, j = n, 1, -1
13155 IF( x( j ).NE.zero )
THEN 13158 $ x( j ) = x( j )/a( kplus1, j )
13160 DO 10, i = j - 1, max( 1, j - k ), -1
13161 x( i ) = x( i ) - temp*a( l + i, j )
13166 kx = kx + ( n - 1 )*incx
13168 DO 40, j = n, 1, -1
13170 IF( x( jx ).NE.zero )
THEN 13174 $ x( jx ) = x( jx )/a( kplus1, j )
13176 DO 30, i = j - 1, max( 1, j - k ), -1
13177 x( ix ) = x( ix ) - temp*a( l + i, j )
13185 IF( incx.EQ.1 )
THEN 13187 IF( x( j ).NE.zero )
THEN 13190 $ x( j ) = x( j )/a( 1, j )
13192 DO 50, i = j + 1, min( n, j + k )
13193 x( i ) = x( i ) - temp*a( l + i, j )
13201 IF( x( jx ).NE.zero )
THEN 13205 $ x( jx ) = x( jx )/a( 1, j )
13207 DO 70, i = j + 1, min( n, j + k )
13208 x( ix ) = x( ix ) - temp*a( l + i, j )
13220 IF( lsame( uplo,
'U' ) )
THEN 13222 IF( incx.EQ.1 )
THEN 13226 DO 90, i = max( 1, j - k ), j - 1
13227 temp = temp - a( l + i, j )*x( i )
13230 $ temp = temp/a( kplus1, j )
13239 DO 110, i = max( 1, j - k ), j - 1
13240 temp = temp - a( l + i, j )*x( ix )
13244 $ temp = temp/a( kplus1, j )
13252 IF( incx.EQ.1 )
THEN 13253 DO 140, j = n, 1, -1
13256 DO 130, i = min( n, j + k ), j + 1, -1
13257 temp = temp - a( l + i, j )*x( i )
13260 $ temp = temp/a( 1, j )
13264 kx = kx + ( n - 1 )*incx
13266 DO 160, j = n, 1, -1
13270 DO 150, i = min( n, j + k ), j + 1, -1
13271 temp = temp - a( l + i, j )*x( ix )
13275 $ temp = temp/a( 1, j )
13278 IF( ( n - j ).GE.k )
13290 SUBROUTINE dtpmv ( UPLO, TRANS, DIAG, N, AP, X, INCX )
13293 CHARACTER*1 DIAG, TRANS, UPLO
13295 DOUBLE PRECISION AP( * ), X( * )
13387 DOUBLE PRECISION ZERO
13388 parameter( zero = 0.0d+0 )
13390 DOUBLE PRECISION TEMP
13391 INTEGER I, INFO, IX, J, JX, K, KK, KX
13404 IF ( .NOT.lsame( uplo ,
'U' ).AND.
13405 $ .NOT.lsame( uplo ,
'L' ) )
THEN 13407 ELSE IF( .NOT.lsame( trans,
'N' ).AND.
13408 $ .NOT.lsame( trans,
'T' ).AND.
13409 $ .NOT.lsame( trans,
'C' ) )
THEN 13411 ELSE IF( .NOT.lsame( diag ,
'U' ).AND.
13412 $ .NOT.lsame( diag ,
'N' ) )
THEN 13414 ELSE IF( n.LT.0 )
THEN 13416 ELSE IF( incx.EQ.0 )
THEN 13419 IF( info.NE.0 )
THEN 13420 CALL xerbla(
'DTPMV ', info )
13429 nounit = lsame( diag,
'N' )
13434 IF( incx.LE.0 )
THEN 13435 kx = 1 - ( n - 1 )*incx
13436 ELSE IF( incx.NE.1 )
THEN 13443 IF( lsame( trans,
'N' ) )
THEN 13447 IF( lsame( uplo,
'U' ) )
THEN 13449 IF( incx.EQ.1 )
THEN 13451 IF( x( j ).NE.zero )
THEN 13454 DO 10, i = 1, j - 1
13455 x( i ) = x( i ) + temp*ap( k )
13459 $ x( j ) = x( j )*ap( kk + j - 1 )
13466 IF( x( jx ).NE.zero )
THEN 13469 DO 30, k = kk, kk + j - 2
13470 x( ix ) = x( ix ) + temp*ap( k )
13474 $ x( jx ) = x( jx )*ap( kk + j - 1 )
13481 kk = ( n*( n + 1 ) )/2
13482 IF( incx.EQ.1 )
THEN 13483 DO 60, j = n, 1, -1
13484 IF( x( j ).NE.zero )
THEN 13487 DO 50, i = n, j + 1, -1
13488 x( i ) = x( i ) + temp*ap( k )
13492 $ x( j ) = x( j )*ap( kk - n + j )
13494 kk = kk - ( n - j + 1 )
13497 kx = kx + ( n - 1 )*incx
13499 DO 80, j = n, 1, -1
13500 IF( x( jx ).NE.zero )
THEN 13503 DO 70, k = kk, kk - ( n - ( j + 1 ) ), -1
13504 x( ix ) = x( ix ) + temp*ap( k )
13508 $ x( jx ) = x( jx )*ap( kk - n + j )
13511 kk = kk - ( n - j + 1 )
13519 IF( lsame( uplo,
'U' ) )
THEN 13520 kk = ( n*( n + 1 ) )/2
13521 IF( incx.EQ.1 )
THEN 13522 DO 100, j = n, 1, -1
13525 $ temp = temp*ap( kk )
13527 DO 90, i = j - 1, 1, -1
13528 temp = temp + ap( k )*x( i )
13535 jx = kx + ( n - 1 )*incx
13536 DO 120, j = n, 1, -1
13540 $ temp = temp*ap( kk )
13541 DO 110, k = kk - 1, kk - j + 1, -1
13543 temp = temp + ap( k )*x( ix )
13552 IF( incx.EQ.1 )
THEN 13556 $ temp = temp*ap( kk )
13558 DO 130, i = j + 1, n
13559 temp = temp + ap( k )*x( i )
13563 kk = kk + ( n - j + 1 )
13571 $ temp = temp*ap( kk )
13572 DO 150, k = kk + 1, kk + n - j
13574 temp = temp + ap( k )*x( ix )
13578 kk = kk + ( n - j + 1 )
13589 SUBROUTINE dtpsv ( UPLO, TRANS, DIAG, N, AP, X, INCX )
13592 CHARACTER*1 DIAG, TRANS, UPLO
13594 DOUBLE PRECISION AP( * ), X( * )
13689 DOUBLE PRECISION ZERO
13690 parameter( zero = 0.0d+0 )
13692 DOUBLE PRECISION TEMP
13693 INTEGER I, INFO, IX, J, JX, K, KK, KX
13706 IF ( .NOT.lsame( uplo ,
'U' ).AND.
13707 $ .NOT.lsame( uplo ,
'L' ) )
THEN 13709 ELSE IF( .NOT.lsame( trans,
'N' ).AND.
13710 $ .NOT.lsame( trans,
'T' ).AND.
13711 $ .NOT.lsame( trans,
'C' ) )
THEN 13713 ELSE IF( .NOT.lsame( diag ,
'U' ).AND.
13714 $ .NOT.lsame( diag ,
'N' ) )
THEN 13716 ELSE IF( n.LT.0 )
THEN 13718 ELSE IF( incx.EQ.0 )
THEN 13721 IF( info.NE.0 )
THEN 13722 CALL xerbla(
'DTPSV ', info )
13731 nounit = lsame( diag,
'N' )
13736 IF( incx.LE.0 )
THEN 13737 kx = 1 - ( n - 1 )*incx
13738 ELSE IF( incx.NE.1 )
THEN 13745 IF( lsame( trans,
'N' ) )
THEN 13749 IF( lsame( uplo,
'U' ) )
THEN 13750 kk = ( n*( n + 1 ) )/2
13751 IF( incx.EQ.1 )
THEN 13752 DO 20, j = n, 1, -1
13753 IF( x( j ).NE.zero )
THEN 13755 $ x( j ) = x( j )/ap( kk )
13758 DO 10, i = j - 1, 1, -1
13759 x( i ) = x( i ) - temp*ap( k )
13766 jx = kx + ( n - 1 )*incx
13767 DO 40, j = n, 1, -1
13768 IF( x( jx ).NE.zero )
THEN 13770 $ x( jx ) = x( jx )/ap( kk )
13773 DO 30, k = kk - 1, kk - j + 1, -1
13775 x( ix ) = x( ix ) - temp*ap( k )
13784 IF( incx.EQ.1 )
THEN 13786 IF( x( j ).NE.zero )
THEN 13788 $ x( j ) = x( j )/ap( kk )
13791 DO 50, i = j + 1, n
13792 x( i ) = x( i ) - temp*ap( k )
13796 kk = kk + ( n - j + 1 )
13801 IF( x( jx ).NE.zero )
THEN 13803 $ x( jx ) = x( jx )/ap( kk )
13806 DO 70, k = kk + 1, kk + n - j
13808 x( ix ) = x( ix ) - temp*ap( k )
13812 kk = kk + ( n - j + 1 )
13820 IF( lsame( uplo,
'U' ) )
THEN 13822 IF( incx.EQ.1 )
THEN 13826 DO 90, i = 1, j - 1
13827 temp = temp - ap( k )*x( i )
13831 $ temp = temp/ap( kk + j - 1 )
13840 DO 110, k = kk, kk + j - 2
13841 temp = temp - ap( k )*x( ix )
13845 $ temp = temp/ap( kk + j - 1 )
13852 kk = ( n*( n + 1 ) )/2
13853 IF( incx.EQ.1 )
THEN 13854 DO 140, j = n, 1, -1
13857 DO 130, i = n, j + 1, -1
13858 temp = temp - ap( k )*x( i )
13862 $ temp = temp/ap( kk - n + j )
13864 kk = kk - ( n - j + 1 )
13867 kx = kx + ( n - 1 )*incx
13869 DO 160, j = n, 1, -1
13872 DO 150, k = kk, kk - ( n - ( j + 1 ) ), -1
13873 temp = temp - ap( k )*x( ix )
13877 $ temp = temp/ap( kk - n + j )
13880 kk = kk - (n - j + 1 )
13891 SUBROUTINE dtrmm ( SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA,
13894 CHARACTER*1 SIDE, UPLO, TRANSA, DIAG
13895 INTEGER M, N, LDA, LDB
13896 DOUBLE PRECISION ALPHA
13898 DOUBLE PRECISION A( lda, * ), B( ldb, * )
14025 LOGICAL LSIDE, NOUNIT, UPPER
14026 INTEGER I, INFO, J, K, NROWA
14027 DOUBLE PRECISION TEMP
14029 DOUBLE PRECISION ONE , ZERO
14030 parameter( one = 1.0d+0, zero = 0.0d+0 )
14036 lside = lsame( side ,
'L' )
14042 nounit = lsame( diag ,
'N' )
14043 upper = lsame( uplo ,
'U' )
14046 IF( ( .NOT.lside ).AND.
14047 $ ( .NOT.lsame( side ,
'R' ) ) )
THEN 14049 ELSE IF( ( .NOT.upper ).AND.
14050 $ ( .NOT.lsame( uplo ,
'L' ) ) )
THEN 14052 ELSE IF( ( .NOT.lsame( transa,
'N' ) ).AND.
14053 $ ( .NOT.lsame( transa,
'T' ) ).AND.
14054 $ ( .NOT.lsame( transa,
'C' ) ) )
THEN 14056 ELSE IF( ( .NOT.lsame( diag ,
'U' ) ).AND.
14057 $ ( .NOT.lsame( diag ,
'N' ) ) )
THEN 14059 ELSE IF( m .LT.0 )
THEN 14061 ELSE IF( n .LT.0 )
THEN 14063 ELSE IF( lda.LT.max( 1, nrowa ) )
THEN 14065 ELSE IF( ldb.LT.max( 1, m ) )
THEN 14068 IF( info.NE.0 )
THEN 14069 CALL xerbla(
'DTRMM ', info )
14080 IF( alpha.EQ.zero )
THEN 14092 IF( lsame( transa,
'N' ) )
THEN 14099 IF( b( k, j ).NE.zero )
THEN 14100 temp = alpha*b( k, j )
14101 DO 30, i = 1, k - 1
14102 b( i, j ) = b( i, j ) + temp*a( i, k )
14105 $ temp = temp*a( k, k )
14113 IF( b( k, j ).NE.zero )
THEN 14114 temp = alpha*b( k, j )
14117 $ b( k, j ) = b( k, j )*a( k, k )
14118 DO 60, i = k + 1, m
14119 b( i, j ) = b( i, j ) + temp*a( i, k )
14131 DO 100, i = m, 1, -1
14134 $ temp = temp*a( i, i )
14135 DO 90, k = 1, i - 1
14136 temp = temp + a( k, i )*b( k, j )
14138 b( i, j ) = alpha*temp
14146 $ temp = temp*a( i, i )
14147 DO 120, k = i + 1, m
14148 temp = temp + a( k, i )*b( k, j )
14150 b( i, j ) = alpha*temp
14156 IF( lsame( transa,
'N' ) )
THEN 14161 DO 180, j = n, 1, -1
14164 $ temp = temp*a( j, j )
14166 b( i, j ) = temp*b( i, j )
14168 DO 170, k = 1, j - 1
14169 IF( a( k, j ).NE.zero )
THEN 14170 temp = alpha*a( k, j )
14172 b( i, j ) = b( i, j ) + temp*b( i, k )
14181 $ temp = temp*a( j, j )
14183 b( i, j ) = temp*b( i, j )
14185 DO 210, k = j + 1, n
14186 IF( a( k, j ).NE.zero )
THEN 14187 temp = alpha*a( k, j )
14189 b( i, j ) = b( i, j ) + temp*b( i, k )
14201 DO 240, j = 1, k - 1
14202 IF( a( j, k ).NE.zero )
THEN 14203 temp = alpha*a( j, k )
14205 b( i, j ) = b( i, j ) + temp*b( i, k )
14211 $ temp = temp*a( k, k )
14212 IF( temp.NE.one )
THEN 14214 b( i, k ) = temp*b( i, k )
14219 DO 300, k = n, 1, -1
14220 DO 280, j = k + 1, n
14221 IF( a( j, k ).NE.zero )
THEN 14222 temp = alpha*a( j, k )
14224 b( i, j ) = b( i, j ) + temp*b( i, k )
14230 $ temp = temp*a( k, k )
14231 IF( temp.NE.one )
THEN 14233 b( i, k ) = temp*b( i, k )
14246 SUBROUTINE dtrmv ( UPLO, TRANS, DIAG, N, A, LDA, X, INCX )
14248 INTEGER INCX, LDA, N
14249 CHARACTER*1 DIAG, TRANS, UPLO
14251 DOUBLE PRECISION A( lda, * ), X( * )
14346 DOUBLE PRECISION ZERO
14347 parameter( zero = 0.0d+0 )
14349 DOUBLE PRECISION TEMP
14350 INTEGER I, INFO, IX, J, JX, KX
14365 IF ( .NOT.lsame( uplo ,
'U' ).AND.
14366 $ .NOT.lsame( uplo ,
'L' ) )
THEN 14368 ELSE IF( .NOT.lsame( trans,
'N' ).AND.
14369 $ .NOT.lsame( trans,
'T' ).AND.
14370 $ .NOT.lsame( trans,
'C' ) )
THEN 14372 ELSE IF( .NOT.lsame( diag ,
'U' ).AND.
14373 $ .NOT.lsame( diag ,
'N' ) )
THEN 14375 ELSE IF( n.LT.0 )
THEN 14377 ELSE IF( lda.LT.max( 1, n ) )
THEN 14379 ELSE IF( incx.EQ.0 )
THEN 14382 IF( info.NE.0 )
THEN 14383 CALL xerbla(
'DTRMV ', info )
14392 nounit = lsame( diag,
'N' )
14397 IF( incx.LE.0 )
THEN 14398 kx = 1 - ( n - 1 )*incx
14399 ELSE IF( incx.NE.1 )
THEN 14406 IF( lsame( trans,
'N' ) )
THEN 14410 IF( lsame( uplo,
'U' ) )
THEN 14411 IF( incx.EQ.1 )
THEN 14413 IF( x( j ).NE.zero )
THEN 14415 DO 10, i = 1, j - 1
14416 x( i ) = x( i ) + temp*a( i, j )
14419 $ x( j ) = x( j )*a( j, j )
14425 IF( x( jx ).NE.zero )
THEN 14428 DO 30, i = 1, j - 1
14429 x( ix ) = x( ix ) + temp*a( i, j )
14433 $ x( jx ) = x( jx )*a( j, j )
14439 IF( incx.EQ.1 )
THEN 14440 DO 60, j = n, 1, -1
14441 IF( x( j ).NE.zero )
THEN 14443 DO 50, i = n, j + 1, -1
14444 x( i ) = x( i ) + temp*a( i, j )
14447 $ x( j ) = x( j )*a( j, j )
14451 kx = kx + ( n - 1 )*incx
14453 DO 80, j = n, 1, -1
14454 IF( x( jx ).NE.zero )
THEN 14457 DO 70, i = n, j + 1, -1
14458 x( ix ) = x( ix ) + temp*a( i, j )
14462 $ x( jx ) = x( jx )*a( j, j )
14472 IF( lsame( uplo,
'U' ) )
THEN 14473 IF( incx.EQ.1 )
THEN 14474 DO 100, j = n, 1, -1
14477 $ temp = temp*a( j, j )
14478 DO 90, i = j - 1, 1, -1
14479 temp = temp + a( i, j )*x( i )
14484 jx = kx + ( n - 1 )*incx
14485 DO 120, j = n, 1, -1
14489 $ temp = temp*a( j, j )
14490 DO 110, i = j - 1, 1, -1
14492 temp = temp + a( i, j )*x( ix )
14499 IF( incx.EQ.1 )
THEN 14503 $ temp = temp*a( j, j )
14504 DO 130, i = j + 1, n
14505 temp = temp + a( i, j )*x( i )
14515 $ temp = temp*a( j, j )
14516 DO 150, i = j + 1, n
14518 temp = temp + a( i, j )*x( ix )
14532 SUBROUTINE dtrsm ( SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA,
14535 CHARACTER*1 SIDE, UPLO, TRANSA, DIAG
14536 INTEGER M, N, LDA, LDB
14537 DOUBLE PRECISION ALPHA
14539 DOUBLE PRECISION A( lda, * ), B( ldb, * )
14669 LOGICAL LSIDE, NOUNIT, UPPER
14670 INTEGER I, INFO, J, K, NROWA
14671 DOUBLE PRECISION TEMP
14673 DOUBLE PRECISION ONE , ZERO
14674 parameter( one = 1.0d+0, zero = 0.0d+0 )
14680 lside = lsame( side ,
'L' )
14686 nounit = lsame( diag ,
'N' )
14687 upper = lsame( uplo ,
'U' )
14690 IF( ( .NOT.lside ).AND.
14691 $ ( .NOT.lsame( side ,
'R' ) ) )
THEN 14693 ELSE IF( ( .NOT.upper ).AND.
14694 $ ( .NOT.lsame( uplo ,
'L' ) ) )
THEN 14696 ELSE IF( ( .NOT.lsame( transa,
'N' ) ).AND.
14697 $ ( .NOT.lsame( transa,
'T' ) ).AND.
14698 $ ( .NOT.lsame( transa,
'C' ) ) )
THEN 14700 ELSE IF( ( .NOT.lsame( diag ,
'U' ) ).AND.
14701 $ ( .NOT.lsame( diag ,
'N' ) ) )
THEN 14703 ELSE IF( m .LT.0 )
THEN 14705 ELSE IF( n .LT.0 )
THEN 14707 ELSE IF( lda.LT.max( 1, nrowa ) )
THEN 14709 ELSE IF( ldb.LT.max( 1, m ) )
THEN 14712 IF( info.NE.0 )
THEN 14713 CALL xerbla(
'DTRSM ', info )
14724 IF( alpha.EQ.zero )
THEN 14736 IF( lsame( transa,
'N' ) )
THEN 14742 IF( alpha.NE.one )
THEN 14744 b( i, j ) = alpha*b( i, j )
14747 DO 50, k = m, 1, -1
14748 IF( b( k, j ).NE.zero )
THEN 14750 $ b( k, j ) = b( k, j )/a( k, k )
14751 DO 40, i = 1, k - 1
14752 b( i, j ) = b( i, j ) - b( k, j )*a( i, k )
14759 IF( alpha.NE.one )
THEN 14761 b( i, j ) = alpha*b( i, j )
14765 IF( b( k, j ).NE.zero )
THEN 14767 $ b( k, j ) = b( k, j )/a( k, k )
14768 DO 80, i = k + 1, m
14769 b( i, j ) = b( i, j ) - b( k, j )*a( i, k )
14782 temp = alpha*b( i, j )
14783 DO 110, k = 1, i - 1
14784 temp = temp - a( k, i )*b( k, j )
14787 $ temp = temp/a( i, i )
14793 DO 150, i = m, 1, -1
14794 temp = alpha*b( i, j )
14795 DO 140, k = i + 1, m
14796 temp = temp - a( k, i )*b( k, j )
14799 $ temp = temp/a( i, i )
14806 IF( lsame( transa,
'N' ) )
THEN 14812 IF( alpha.NE.one )
THEN 14814 b( i, j ) = alpha*b( i, j )
14817 DO 190, k = 1, j - 1
14818 IF( a( k, j ).NE.zero )
THEN 14820 b( i, j ) = b( i, j ) - a( k, j )*b( i, k )
14825 temp = one/a( j, j )
14827 b( i, j ) = temp*b( i, j )
14832 DO 260, j = n, 1, -1
14833 IF( alpha.NE.one )
THEN 14835 b( i, j ) = alpha*b( i, j )
14838 DO 240, k = j + 1, n
14839 IF( a( k, j ).NE.zero )
THEN 14841 b( i, j ) = b( i, j ) - a( k, j )*b( i, k )
14846 temp = one/a( j, j )
14848 b( i, j ) = temp*b( i, j )
14858 DO 310, k = n, 1, -1
14860 temp = one/a( k, k )
14862 b( i, k ) = temp*b( i, k )
14865 DO 290, j = 1, k - 1
14866 IF( a( j, k ).NE.zero )
THEN 14869 b( i, j ) = b( i, j ) - temp*b( i, k )
14873 IF( alpha.NE.one )
THEN 14875 b( i, k ) = alpha*b( i, k )
14882 temp = one/a( k, k )
14884 b( i, k ) = temp*b( i, k )
14887 DO 340, j = k + 1, n
14888 IF( a( j, k ).NE.zero )
THEN 14891 b( i, j ) = b( i, j ) - temp*b( i, k )
14895 IF( alpha.NE.one )
THEN 14897 b( i, k ) = alpha*b( i, k )
14910 SUBROUTINE dtrsv ( UPLO, TRANS, DIAG, N, A, LDA, X, INCX )
14912 INTEGER INCX, LDA, N
14913 CHARACTER*1 DIAG, TRANS, UPLO
14915 DOUBLE PRECISION A( lda, * ), X( * )
15013 DOUBLE PRECISION ZERO
15014 parameter( zero = 0.0d+0 )
15016 DOUBLE PRECISION TEMP
15017 INTEGER I, INFO, IX, J, JX, KX
15032 IF ( .NOT.lsame( uplo ,
'U' ).AND.
15033 $ .NOT.lsame( uplo ,
'L' ) )
THEN 15035 ELSE IF( .NOT.lsame( trans,
'N' ).AND.
15036 $ .NOT.lsame( trans,
'T' ).AND.
15037 $ .NOT.lsame( trans,
'C' ) )
THEN 15039 ELSE IF( .NOT.lsame( diag ,
'U' ).AND.
15040 $ .NOT.lsame( diag ,
'N' ) )
THEN 15042 ELSE IF( n.LT.0 )
THEN 15044 ELSE IF( lda.LT.max( 1, n ) )
THEN 15046 ELSE IF( incx.EQ.0 )
THEN 15049 IF( info.NE.0 )
THEN 15050 CALL xerbla(
'DTRSV ', info )
15059 nounit = lsame( diag,
'N' )
15064 IF( incx.LE.0 )
THEN 15065 kx = 1 - ( n - 1 )*incx
15066 ELSE IF( incx.NE.1 )
THEN 15073 IF( lsame( trans,
'N' ) )
THEN 15077 IF( lsame( uplo,
'U' ) )
THEN 15078 IF( incx.EQ.1 )
THEN 15079 DO 20, j = n, 1, -1
15080 IF( x( j ).NE.zero )
THEN 15082 $ x( j ) = x( j )/a( j, j )
15084 DO 10, i = j - 1, 1, -1
15085 x( i ) = x( i ) - temp*a( i, j )
15090 jx = kx + ( n - 1 )*incx
15091 DO 40, j = n, 1, -1
15092 IF( x( jx ).NE.zero )
THEN 15094 $ x( jx ) = x( jx )/a( j, j )
15097 DO 30, i = j - 1, 1, -1
15099 x( ix ) = x( ix ) - temp*a( i, j )
15106 IF( incx.EQ.1 )
THEN 15108 IF( x( j ).NE.zero )
THEN 15110 $ x( j ) = x( j )/a( j, j )
15112 DO 50, i = j + 1, n
15113 x( i ) = x( i ) - temp*a( i, j )
15120 IF( x( jx ).NE.zero )
THEN 15122 $ x( jx ) = x( jx )/a( j, j )
15125 DO 70, i = j + 1, n
15127 x( ix ) = x( ix ) - temp*a( i, j )
15138 IF( lsame( uplo,
'U' ) )
THEN 15139 IF( incx.EQ.1 )
THEN 15142 DO 90, i = 1, j - 1
15143 temp = temp - a( i, j )*x( i )
15146 $ temp = temp/a( j, j )
15154 DO 110, i = 1, j - 1
15155 temp = temp - a( i, j )*x( ix )
15159 $ temp = temp/a( j, j )
15165 IF( incx.EQ.1 )
THEN 15166 DO 140, j = n, 1, -1
15168 DO 130, i = n, j + 1, -1
15169 temp = temp - a( i, j )*x( i )
15172 $ temp = temp/a( j, j )
15176 kx = kx + ( n - 1 )*incx
15178 DO 160, j = n, 1, -1
15181 DO 150, i = n, j + 1, -1
15182 temp = temp - a( i, j )*x( ix )
15186 $ temp = temp/a( j, j )
15199 double precision function dzasum(n,zx,incx)
15206 double complex zx(*)
15207 double precision stemp,dcabs1
15208 integer i,incx,ix,n
15212 if( n.le.0 .or. incx.le.0 )
return 15213 if(incx.eq.1)
go to 20
15219 stemp = stemp + dcabs1(zx(ix))
15228 stemp = stemp + dcabs1(zx(i))
15233 DOUBLE PRECISION FUNCTION dznrm2( N, X, INCX )
15253 DOUBLE PRECISION ONE , ZERO
15254 parameter( one = 1.0d+0, zero = 0.0d+0 )
15257 DOUBLE PRECISION NORM, SCALE, SSQ, TEMP
15259 INTRINSIC abs, dimag, dble, sqrt
15262 IF( n.LT.1 .OR. incx.LT.1 )
THEN 15271 DO 10, ix = 1, 1 + ( n - 1 )*incx, incx
15272 IF( dble( x( ix ) ).NE.zero )
THEN 15273 temp = abs( dble( x( ix ) ) )
15274 IF( scale.LT.temp )
THEN 15275 ssq = one + ssq*( scale/temp )**2
15278 ssq = ssq + ( temp/scale )**2
15281 IF( dimag( x( ix ) ).NE.zero )
THEN 15282 temp = abs( dimag( x( ix ) ) )
15283 IF( scale.LT.temp )
THEN 15284 ssq = one + ssq*( scale/temp )**2
15287 ssq = ssq + ( temp/scale )**2
15291 norm = scale * sqrt( ssq )
15300 integer function icamax(n,cx,incx)
15309 integer i,incx,ix,n
15312 cabs1(zdum) = abs(
real(zdum)) + abs(aimag(zdum))
15315 if( n.lt.1 .or. incx.le.0 )
return 15318 if(incx.eq.1)
go to 20
15323 smax = cabs1(cx(1))
15326 if(cabs1(cx(ix)).le.smax)
go to 5
15328 smax = cabs1(cx(ix))
15335 20 smax = cabs1(cx(1))
15337 if(cabs1(cx(i)).le.smax)
go to 30
15339 smax = cabs1(cx(i))
15343 integer function idamax(n,dx,incx)
15350 double precision dx(*),dmax
15351 integer i,incx,ix,n
15354 if( n.lt.1 .or. incx.le.0 )
return 15357 if(incx.eq.1)
go to 20
15365 if(dabs(dx(ix)).le.dmax)
go to 5
15367 dmax = dabs(dx(ix))
15374 20 dmax = dabs(dx(1))
15376 if(dabs(dx(i)).le.dmax)
go to 30
15382 integer function isamax(n,sx,incx)
15390 integer i,incx,ix,n
15393 if( n.lt.1 .or. incx.le.0 )
return 15396 if(incx.eq.1)
go to 20
15404 if(abs(sx(ix)).le.smax)
go to 5
15413 20 smax = abs(sx(1))
15415 if(abs(sx(i)).le.smax)
go to 30
15421 integer function izamax(n,zx,incx)
15428 double complex zx(*)
15429 double precision smax
15430 integer i,incx,ix,n
15431 double precision dcabs1
15434 if( n.lt.1 .or. incx.le.0 )
return 15437 if(incx.eq.1)
go to 20
15442 smax = dcabs1(zx(1))
15445 if(dcabs1(zx(ix)).le.smax)
go to 5
15447 smax = dcabs1(zx(ix))
15454 20 smax = dcabs1(zx(1))
15456 if(dcabs1(zx(i)).le.smax)
go to 30
15458 smax = dcabs1(zx(i))
15462 LOGICAL FUNCTION lsame( CA, CB )
15492 INTEGER INTA, INTB, ZCODE
15504 zcode = ichar(
'Z' )
15514 IF( zcode.EQ.90 .OR. zcode.EQ.122 )
THEN 15519 IF( inta.GE.97 .AND. inta.LE.122 ) inta = inta - 32
15520 IF( intb.GE.97 .AND. intb.LE.122 ) intb = intb - 32
15522 ELSE IF( zcode.EQ.233 .OR. zcode.EQ.169 )
THEN 15527 IF( inta.GE.129 .AND. inta.LE.137 .OR.
15528 $ inta.GE.145 .AND. inta.LE.153 .OR.
15529 $ inta.GE.162 .AND. inta.LE.169 ) inta = inta + 64
15530 IF( intb.GE.129 .AND. intb.LE.137 .OR.
15531 $ intb.GE.145 .AND. intb.LE.153 .OR.
15532 $ intb.GE.162 .AND. intb.LE.169 ) intb = intb + 64
15534 ELSE IF( zcode.EQ.218 .OR. zcode.EQ.250 )
THEN 15539 IF( inta.GE.225 .AND. inta.LE.250 ) inta = inta - 32
15540 IF( intb.GE.225 .AND. intb.LE.250 ) intb = intb - 32
15542 lsame = inta.EQ.intb
15549 real function sasum(n,sx,incx)
15558 integer i,incx,m,mp1,n,nincx
15562 if( n.le.0 .or. incx.le.0 )
return 15563 if(incx.eq.1)
go to 20
15568 do 10 i = 1,nincx,incx
15569 stemp = stemp + abs(sx(i))
15580 if( m .eq. 0 )
go to 40
15582 stemp = stemp + abs(sx(i))
15584 if( n .lt. 6 )
go to 60
15587 stemp = stemp + abs(sx(i)) + abs(sx(i + 1)) + abs(sx(i + 2))
15588 * + abs(sx(i + 3)) + abs(sx(i + 4)) + abs(sx(i + 5))
15593 subroutine saxpy(n,sa,sx,incx,sy,incy)
15600 real sx(*),sy(*),sa
15601 integer i,incx,incy,ix,iy,m,mp1,n
15604 if (sa .eq. 0.0)
return 15605 if(incx.eq.1.and.incy.eq.1)
go to 20
15612 if(incx.lt.0)ix = (-n+1)*incx + 1
15613 if(incy.lt.0)iy = (-n+1)*incy + 1
15615 sy(iy) = sy(iy) + sa*sx(ix)
15627 if( m .eq. 0 )
go to 40
15629 sy(i) = sy(i) + sa*sx(i)
15631 if( n .lt. 4 )
return 15634 sy(i) = sy(i) + sa*sx(i)
15635 sy(i + 1) = sy(i + 1) + sa*sx(i + 1)
15636 sy(i + 2) = sy(i + 2) + sa*sx(i + 2)
15637 sy(i + 3) = sy(i + 3) + sa*sx(i + 3)
15641 real function scasum(n,cx,incx)
15651 integer i,incx,n,nincx
15655 if( n.le.0 .or. incx.le.0 )
return 15656 if(incx.eq.1)
go to 20
15661 do 10 i = 1,nincx,incx
15662 stemp = stemp + abs(
real(cx(i))) + abs(aimag(cx(i)))
15670 stemp = stemp + abs(
real(cx(i))) + abs(aimag(cx(i)))
15675 REAL FUNCTION scnrm2( N, X, INCX )
15696 parameter( one = 1.0e+0, zero = 0.0e+0 )
15699 REAL NORM, SCALE, SSQ, TEMP
15701 INTRINSIC abs, aimag,
REAL, SQRT
15704 IF( n.LT.1 .OR. incx.LT.1 )
THEN 15713 DO 10, ix = 1, 1 + ( n - 1 )*incx, incx
15714 IF(
REAL( X( IX ) ).NE.zero )then
15715 temp = abs(
REAL( X( IX ) ) )
15716 IF( scale.LT.temp )
THEN 15717 ssq = one + ssq*( scale/temp )**2
15720 ssq = ssq + ( temp/scale )**2
15723 IF( aimag( x( ix ) ).NE.zero )
THEN 15724 temp = abs( aimag( x( ix ) ) )
15725 IF( scale.LT.temp )
THEN 15726 ssq = one + ssq*( scale/temp )**2
15729 ssq = ssq + ( temp/scale )**2
15733 norm = scale * sqrt( ssq )
15742 subroutine scopy(n,sx,incx,sy,incy)
15750 integer i,incx,incy,ix,iy,m,mp1,n
15753 if(incx.eq.1.and.incy.eq.1)
go to 20
15760 if(incx.lt.0)ix = (-n+1)*incx + 1
15761 if(incy.lt.0)iy = (-n+1)*incy + 1
15775 if( m .eq. 0 )
go to 40
15779 if( n .lt. 7 )
return 15783 sy(i + 1) = sx(i + 1)
15784 sy(i + 2) = sx(i + 2)
15785 sy(i + 3) = sx(i + 3)
15786 sy(i + 4) = sx(i + 4)
15787 sy(i + 5) = sx(i + 5)
15788 sy(i + 6) = sx(i + 6)
15792 real function sdot(n,sx,incx,sy,incy)
15799 real sx(*),sy(*),stemp
15800 integer i,incx,incy,ix,iy,m,mp1,n
15805 if(incx.eq.1.and.incy.eq.1)
go to 20
15812 if(incx.lt.0)ix = (-n+1)*incx + 1
15813 if(incy.lt.0)iy = (-n+1)*incy + 1
15815 stemp = stemp + sx(ix)*sy(iy)
15828 if( m .eq. 0 )
go to 40
15830 stemp = stemp + sx(i)*sy(i)
15832 if( n .lt. 5 )
go to 60
15835 stemp = stemp + sx(i)*sy(i) + sx(i + 1)*sy(i + 1) +
15836 * sx(i + 2)*sy(i + 2) + sx(i + 3)*sy(i + 3) + sx(i + 4)*sy(i + 4)
15842 REAL FUNCTION sdsdot (N, SB, SX, INCX, SY, INCY)
15889 REAL SX(*), SY(*), SB
15890 DOUBLE PRECISION DSDOT
15893 IF (
n .LE. 0)
GO TO 30
15894 IF (incx.EQ.incy .AND. incx.GT.0)
GO TO 40
15900 IF (incx .LT. 0) kx = 1+(1-
n)*incx
15901 IF (incy .LT. 0) ky = 1+(1-
n)*incy
15903 dsdot = dsdot + dble(sx(kx))*dble(sy(ky))
15913 DO 50
i = 1,ns,incx
15914 dsdot = dsdot + dble(sx(
i))*dble(sy(
i))
15919 SUBROUTINE sgbmv ( TRANS, M, N, KL, KU, ALPHA, A, LDA, X, INCX,
15923 INTEGER INCX, INCY, KL, KU, LDA, M, N
15926 REAL A( lda, * ), X( * ), Y( * )
16047 parameter( one = 1.0e+0, zero = 0.0e+0 )
16050 INTEGER I, INFO, IX, IY, J, JX, JY, K, KUP1, KX, KY,
16065 IF ( .NOT.lsame( trans,
'N' ).AND.
16066 $ .NOT.lsame( trans,
'T' ).AND.
16067 $ .NOT.lsame( trans,
'C' ) )
THEN 16069 ELSE IF( m.LT.0 )
THEN 16071 ELSE IF( n.LT.0 )
THEN 16073 ELSE IF( kl.LT.0 )
THEN 16075 ELSE IF( ku.LT.0 )
THEN 16077 ELSE IF( lda.LT.( kl + ku + 1 ) )
THEN 16079 ELSE IF( incx.EQ.0 )
THEN 16081 ELSE IF( incy.EQ.0 )
THEN 16084 IF( info.NE.0 )
THEN 16085 CALL xerbla(
'SGBMV ', info )
16091 IF( ( m.EQ.0 ).OR.( n.EQ.0 ).OR.
16092 $ ( ( alpha.EQ.zero ).AND.( beta.EQ.one ) ) )
16098 IF( lsame( trans,
'N' ) )
THEN 16105 IF( incx.GT.0 )
THEN 16108 kx = 1 - ( lenx - 1 )*incx
16110 IF( incy.GT.0 )
THEN 16113 ky = 1 - ( leny - 1 )*incy
16121 IF( beta.NE.one )
THEN 16122 IF( incy.EQ.1 )
THEN 16123 IF( beta.EQ.zero )
THEN 16129 y( i ) = beta*y( i )
16134 IF( beta.EQ.zero )
THEN 16141 y( iy ) = beta*y( iy )
16147 IF( alpha.EQ.zero )
16150 IF( lsame( trans,
'N' ) )
THEN 16155 IF( incy.EQ.1 )
THEN 16157 IF( x( jx ).NE.zero )
THEN 16158 temp = alpha*x( jx )
16160 DO 50, i = max( 1, j - ku ), min( m, j + kl )
16161 y( i ) = y( i ) + temp*a( k + i, j )
16168 IF( x( jx ).NE.zero )
THEN 16169 temp = alpha*x( jx )
16172 DO 70, i = max( 1, j - ku ), min( m, j + kl )
16173 y( iy ) = y( iy ) + temp*a( k + i, j )
16187 IF( incx.EQ.1 )
THEN 16191 DO 90, i = max( 1, j - ku ), min( m, j + kl )
16192 temp = temp + a( k + i, j )*x( i )
16194 y( jy ) = y( jy ) + alpha*temp
16202 DO 110, i = max( 1, j - ku ), min( m, j + kl )
16203 temp = temp + a( k + i, j )*x( ix )
16206 y( jy ) = y( jy ) + alpha*temp
16219 SUBROUTINE sgemm ( TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB,
16222 CHARACTER*1 TRANSA, TRANSB
16223 INTEGER M, N, K, LDA, LDB, LDC
16226 REAL A( lda, * ), B( ldb, * ), C( ldc, * )
16358 INTEGER I, INFO, J, L, NCOLA, NROWA, NROWB
16362 parameter( one = 1.0e+0, zero = 0.0e+0 )
16370 nota = lsame( transa,
'N' )
16371 notb = lsame( transb,
'N' )
16388 IF( ( .NOT.nota ).AND.
16389 $ ( .NOT.lsame( transa,
'C' ) ).AND.
16390 $ ( .NOT.lsame( transa,
'T' ) ) )
THEN 16392 ELSE IF( ( .NOT.notb ).AND.
16393 $ ( .NOT.lsame( transb,
'C' ) ).AND.
16394 $ ( .NOT.lsame( transb,
'T' ) ) )
THEN 16396 ELSE IF( m .LT.0 )
THEN 16398 ELSE IF( n .LT.0 )
THEN 16400 ELSE IF( k .LT.0 )
THEN 16402 ELSE IF( lda.LT.max( 1, nrowa ) )
THEN 16404 ELSE IF( ldb.LT.max( 1, nrowb ) )
THEN 16406 ELSE IF( ldc.LT.max( 1, m ) )
THEN 16409 IF( info.NE.0 )
THEN 16410 CALL xerbla(
'SGEMM ', info )
16416 IF( ( m.EQ.0 ).OR.( n.EQ.0 ).OR.
16417 $ ( ( ( alpha.EQ.zero ).OR.( k.EQ.0 ) ).AND.( beta.EQ.one ) ) )
16422 IF( alpha.EQ.zero )
THEN 16423 IF( beta.EQ.zero )
THEN 16432 c( i, j ) = beta*c( i, j )
16447 IF( beta.EQ.zero )
THEN 16451 ELSE IF( beta.NE.one )
THEN 16453 c( i, j ) = beta*c( i, j )
16457 IF( b( l, j ).NE.zero )
THEN 16458 temp = alpha*b( l, j )
16460 c( i, j ) = c( i, j ) + temp*a( i, l )
16473 temp = temp + a( l, i )*b( l, j )
16475 IF( beta.EQ.zero )
THEN 16476 c( i, j ) = alpha*temp
16478 c( i, j ) = alpha*temp + beta*c( i, j )
16489 IF( beta.EQ.zero )
THEN 16493 ELSE IF( beta.NE.one )
THEN 16495 c( i, j ) = beta*c( i, j )
16499 IF( b( j, l ).NE.zero )
THEN 16500 temp = alpha*b( j, l )
16502 c( i, j ) = c( i, j ) + temp*a( i, l )
16515 temp = temp + a( l, i )*b( j, l )
16517 IF( beta.EQ.zero )
THEN 16518 c( i, j ) = alpha*temp
16520 c( i, j ) = alpha*temp + beta*c( i, j )
16532 SUBROUTINE sgemv ( TRANS, M, N, ALPHA, A, LDA, X, INCX,
16536 INTEGER INCX, INCY, LDA, M, N
16539 REAL A( lda, * ), X( * ), Y( * )
16635 parameter( one = 1.0e+0, zero = 0.0e+0 )
16638 INTEGER I, INFO, IX, IY, J, JX, JY, KX, KY, LENX, LENY
16652 IF ( .NOT.lsame( trans,
'N' ).AND.
16653 $ .NOT.lsame( trans,
'T' ).AND.
16654 $ .NOT.lsame( trans,
'C' ) )
THEN 16656 ELSE IF( m.LT.0 )
THEN 16658 ELSE IF( n.LT.0 )
THEN 16660 ELSE IF( lda.LT.max( 1, m ) )
THEN 16662 ELSE IF( incx.EQ.0 )
THEN 16664 ELSE IF( incy.EQ.0 )
THEN 16667 IF( info.NE.0 )
THEN 16668 CALL xerbla(
'SGEMV ', info )
16674 IF( ( m.EQ.0 ).OR.( n.EQ.0 ).OR.
16675 $ ( ( alpha.EQ.zero ).AND.( beta.EQ.one ) ) )
16681 IF( lsame( trans,
'N' ) )
THEN 16688 IF( incx.GT.0 )
THEN 16691 kx = 1 - ( lenx - 1 )*incx
16693 IF( incy.GT.0 )
THEN 16696 ky = 1 - ( leny - 1 )*incy
16704 IF( beta.NE.one )
THEN 16705 IF( incy.EQ.1 )
THEN 16706 IF( beta.EQ.zero )
THEN 16712 y( i ) = beta*y( i )
16717 IF( beta.EQ.zero )
THEN 16724 y( iy ) = beta*y( iy )
16730 IF( alpha.EQ.zero )
16732 IF( lsame( trans,
'N' ) )
THEN 16737 IF( incy.EQ.1 )
THEN 16739 IF( x( jx ).NE.zero )
THEN 16740 temp = alpha*x( jx )
16742 y( i ) = y( i ) + temp*a( i, j )
16749 IF( x( jx ).NE.zero )
THEN 16750 temp = alpha*x( jx )
16753 y( iy ) = y( iy ) + temp*a( i, j )
16765 IF( incx.EQ.1 )
THEN 16769 temp = temp + a( i, j )*x( i )
16771 y( jy ) = y( jy ) + alpha*temp
16779 temp = temp + a( i, j )*x( ix )
16782 y( jy ) = y( jy ) + alpha*temp
16793 SUBROUTINE sger ( M, N, ALPHA, X, INCX, Y, INCY, A, LDA )
16796 INTEGER INCX, INCY, LDA, M, N
16798 REAL A( lda, * ), X( * ), Y( * )
16873 parameter( zero = 0.0e+0 )
16876 INTEGER I, INFO, IX, J, JY, KX
16889 ELSE IF( n.LT.0 )
THEN 16891 ELSE IF( incx.EQ.0 )
THEN 16893 ELSE IF( incy.EQ.0 )
THEN 16895 ELSE IF( lda.LT.max( 1, m ) )
THEN 16898 IF( info.NE.0 )
THEN 16899 CALL xerbla(
'SGER ', info )
16905 IF( ( m.EQ.0 ).OR.( n.EQ.0 ).OR.( alpha.EQ.zero ) )
16911 IF( incy.GT.0 )
THEN 16914 jy = 1 - ( n - 1 )*incy
16916 IF( incx.EQ.1 )
THEN 16918 IF( y( jy ).NE.zero )
THEN 16919 temp = alpha*y( jy )
16921 a( i, j ) = a( i, j ) + x( i )*temp
16927 IF( incx.GT.0 )
THEN 16930 kx = 1 - ( m - 1 )*incx
16933 IF( y( jy ).NE.zero )
THEN 16934 temp = alpha*y( jy )
16937 a( i, j ) = a( i, j ) + x( ix )*temp
16950 REAL FUNCTION snrm2 ( N, X, INCX )
16971 parameter( one = 1.0e+0, zero = 0.0e+0 )
16974 REAL ABSXI, NORM, SCALE, SSQ
16976 INTRINSIC abs, sqrt
16979 IF( n.LT.1 .OR. incx.LT.1 )
THEN 16981 ELSE IF( n.EQ.1 )
THEN 16982 norm = abs( x( 1 ) )
16990 DO 10, ix = 1, 1 + ( n - 1 )*incx, incx
16991 IF( x( ix ).NE.zero )
THEN 16992 absxi = abs( x( ix ) )
16993 IF( scale.LT.absxi )
THEN 16994 ssq = one + ssq*( scale/absxi )**2
16997 ssq = ssq + ( absxi/scale )**2
17001 norm = scale * sqrt( ssq )
17010 subroutine srot (n,sx,incx,sy,incy,c,s)
17016 real sx(*),sy(*),stemp,c,s
17017 integer i,incx,incy,ix,iy,n
17020 if(incx.eq.1.and.incy.eq.1)
go to 20
17027 if(incx.lt.0)ix = (-n+1)*incx + 1
17028 if(incy.lt.0)iy = (-n+1)*incy + 1
17030 stemp = c*sx(ix) + s*sy(iy)
17031 sy(iy) = c*sy(iy) - s*sx(ix)
17041 stemp = c*sx(i) + s*sy(i)
17042 sy(i) = c*sy(i) - s*sx(i)
17047 subroutine srotg(sa,sb,c,s)
17052 real sa,sb,c,s,roe,scale,r,z
17055 if( abs(sa) .gt. abs(sb) ) roe = sa
17056 scale = abs(sa) + abs(sb)
17057 if( scale .ne. 0.0 )
go to 10
17063 10 r = scale*sqrt((sa/scale)**2 + (sb/scale)**2)
17064 r = sign(1.0,roe)*r
17068 if( abs(sa) .gt. abs(sb) ) z = s
17069 if( abs(sb) .ge. abs(sa) .and. c .ne. 0.0 ) z = 1.0/c
17074 SUBROUTINE srotm (N,SX,INCX,SY,INCY,SPARAM)
17092 dimension sx(1),sy(1),sparam(5)
17093 DATA zero,two/0.e0,2.e0/
17096 IF(
n .LE. 0 .OR.(sflag+two.EQ.zero))
GO TO 140
17097 IF(.NOT.(incx.EQ.incy.AND. incx .GT.0))
GO TO 70
17104 DO 20
i=1,nsteps,incx
17114 DO 40
i=1,nsteps,incx
17126 DO 60
i=1,nsteps,incx
17129 sx(
i)=w*sh11+z*sh12
17130 sy(
i)=w*sh21+z*sh22
17136 IF(incx .LT. 0) kx=1+(1-
n)*incx
17137 IF(incy .LT. 0) ky=1+(1-
n)*incy
17139 IF(sflag)120,80,100
17172 sx(kx)=w*sh11+z*sh12
17173 sy(ky)=w*sh21+z*sh22
17180 SUBROUTINE srotmg (SD1,SD2,SX1,SY1,SPARAM)
17200 dimension sparam(5)
17202 DATA zero,one,two /0.e0,1.e0,2.e0/
17203 DATA gam,gamsq,rgamsq/4096.e0,1.67772e7,5.96046e-8/
17204 IF(.NOT. sd1 .LT. zero)
GO TO 10
17210 IF(.NOT. sp2 .EQ. zero)
GO TO 20
17219 IF(.NOT. abs(sq1) .GT. abs(sq2))
GO TO 40
17225 IF(.NOT. su .LE. zero)
GO TO 30
17236 IF(.NOT. sq2 .LT. zero)
GO TO 50
17265 IF(.NOT. sflag .GE. zero)
GO TO 90
17267 IF(.NOT. sflag .EQ. zero)
GO TO 80
17277 GO TO igo,(120,150,180,210)
17281 IF(.NOT. sd1 .LE. rgamsq)
GO TO 130
17282 IF(sd1 .EQ. zero)
GO TO 160
17294 IF(.NOT. sd1 .GE. gamsq)
GO TO 160
17306 IF(.NOT. abs(sd2) .LE. rgamsq)
GO TO 190
17307 IF(sd2 .EQ. zero)
GO TO 220
17318 IF(.NOT. abs(sd2) .GE. gamsq)
GO TO 220
17328 IF(sflag)250,230,240
17346 SUBROUTINE ssbmv ( UPLO, N, K, ALPHA, A, LDA, X, INCX,
17350 INTEGER INCX, INCY, K, LDA, N
17353 REAL A( lda, * ), X( * ), Y( * )
17478 parameter( one = 1.0e+0, zero = 0.0e+0 )
17481 INTEGER I, INFO, IX, IY, J, JX, JY, KPLUS1, KX, KY, L
17495 IF ( .NOT.lsame( uplo,
'U' ).AND.
17496 $ .NOT.lsame( uplo,
'L' ) )
THEN 17498 ELSE IF( n.LT.0 )
THEN 17500 ELSE IF( k.LT.0 )
THEN 17502 ELSE IF( lda.LT.( k + 1 ) )
THEN 17504 ELSE IF( incx.EQ.0 )
THEN 17506 ELSE IF( incy.EQ.0 )
THEN 17509 IF( info.NE.0 )
THEN 17510 CALL xerbla(
'SSBMV ', info )
17516 IF( ( n.EQ.0 ).OR.( ( alpha.EQ.zero ).AND.( beta.EQ.one ) ) )
17521 IF( incx.GT.0 )
THEN 17524 kx = 1 - ( n - 1 )*incx
17526 IF( incy.GT.0 )
THEN 17529 ky = 1 - ( n - 1 )*incy
17537 IF( beta.NE.one )
THEN 17538 IF( incy.EQ.1 )
THEN 17539 IF( beta.EQ.zero )
THEN 17545 y( i ) = beta*y( i )
17550 IF( beta.EQ.zero )
THEN 17557 y( iy ) = beta*y( iy )
17563 IF( alpha.EQ.zero )
17565 IF( lsame( uplo,
'U' ) )
THEN 17570 IF( ( incx.EQ.1 ).AND.( incy.EQ.1 ) )
THEN 17572 temp1 = alpha*x( j )
17575 DO 50, i = max( 1, j - k ), j - 1
17576 y( i ) = y( i ) + temp1*a( l + i, j )
17577 temp2 = temp2 + a( l + i, j )*x( i )
17579 y( j ) = y( j ) + temp1*a( kplus1, j ) + alpha*temp2
17585 temp1 = alpha*x( jx )
17590 DO 70, i = max( 1, j - k ), j - 1
17591 y( iy ) = y( iy ) + temp1*a( l + i, j )
17592 temp2 = temp2 + a( l + i, j )*x( ix )
17596 y( jy ) = y( jy ) + temp1*a( kplus1, j ) + alpha*temp2
17609 IF( ( incx.EQ.1 ).AND.( incy.EQ.1 ) )
THEN 17611 temp1 = alpha*x( j )
17613 y( j ) = y( j ) + temp1*a( 1, j )
17615 DO 90, i = j + 1, min( n, j + k )
17616 y( i ) = y( i ) + temp1*a( l + i, j )
17617 temp2 = temp2 + a( l + i, j )*x( i )
17619 y( j ) = y( j ) + alpha*temp2
17625 temp1 = alpha*x( jx )
17627 y( jy ) = y( jy ) + temp1*a( 1, j )
17631 DO 110, i = j + 1, min( n, j + k )
17634 y( iy ) = y( iy ) + temp1*a( l + i, j )
17635 temp2 = temp2 + a( l + i, j )*x( ix )
17637 y( jy ) = y( jy ) + alpha*temp2
17649 subroutine sscal(n,sa,sx,incx)
17658 integer i,incx,m,mp1,n,nincx
17660 if( n.le.0 .or. incx.le.0 )
return 17661 if(incx.eq.1)
go to 20
17666 do 10 i = 1,nincx,incx
17677 if( m .eq. 0 )
go to 40
17681 if( n .lt. 5 )
return 17685 sx(i + 1) = sa*sx(i + 1)
17686 sx(i + 2) = sa*sx(i + 2)
17687 sx(i + 3) = sa*sx(i + 3)
17688 sx(i + 4) = sa*sx(i + 4)
17692 SUBROUTINE sspmv ( UPLO, N, ALPHA, AP, X, INCX, BETA, Y, INCY )
17695 INTEGER INCX, INCY, N
17698 REAL AP( * ), X( * ), Y( * )
17789 parameter( one = 1.0e+0, zero = 0.0e+0 )
17792 INTEGER I, INFO, IX, IY, J, JX, JY, K, KK, KX, KY
17804 IF ( .NOT.lsame( uplo,
'U' ).AND.
17805 $ .NOT.lsame( uplo,
'L' ) )
THEN 17807 ELSE IF( n.LT.0 )
THEN 17809 ELSE IF( incx.EQ.0 )
THEN 17811 ELSE IF( incy.EQ.0 )
THEN 17814 IF( info.NE.0 )
THEN 17815 CALL xerbla(
'SSPMV ', info )
17821 IF( ( n.EQ.0 ).OR.( ( alpha.EQ.zero ).AND.( beta.EQ.one ) ) )
17826 IF( incx.GT.0 )
THEN 17829 kx = 1 - ( n - 1 )*incx
17831 IF( incy.GT.0 )
THEN 17834 ky = 1 - ( n - 1 )*incy
17842 IF( beta.NE.one )
THEN 17843 IF( incy.EQ.1 )
THEN 17844 IF( beta.EQ.zero )
THEN 17850 y( i ) = beta*y( i )
17855 IF( beta.EQ.zero )
THEN 17862 y( iy ) = beta*y( iy )
17868 IF( alpha.EQ.zero )
17871 IF( lsame( uplo,
'U' ) )
THEN 17875 IF( ( incx.EQ.1 ).AND.( incy.EQ.1 ) )
THEN 17877 temp1 = alpha*x( j )
17880 DO 50, i = 1, j - 1
17881 y( i ) = y( i ) + temp1*ap( k )
17882 temp2 = temp2 + ap( k )*x( i )
17885 y( j ) = y( j ) + temp1*ap( kk + j - 1 ) + alpha*temp2
17892 temp1 = alpha*x( jx )
17896 DO 70, k = kk, kk + j - 2
17897 y( iy ) = y( iy ) + temp1*ap( k )
17898 temp2 = temp2 + ap( k )*x( ix )
17902 y( jy ) = y( jy ) + temp1*ap( kk + j - 1 ) + alpha*temp2
17912 IF( ( incx.EQ.1 ).AND.( incy.EQ.1 ) )
THEN 17914 temp1 = alpha*x( j )
17916 y( j ) = y( j ) + temp1*ap( kk )
17918 DO 90, i = j + 1, n
17919 y( i ) = y( i ) + temp1*ap( k )
17920 temp2 = temp2 + ap( k )*x( i )
17923 y( j ) = y( j ) + alpha*temp2
17924 kk = kk + ( n - j + 1 )
17930 temp1 = alpha*x( jx )
17932 y( jy ) = y( jy ) + temp1*ap( kk )
17935 DO 110, k = kk + 1, kk + n - j
17938 y( iy ) = y( iy ) + temp1*ap( k )
17939 temp2 = temp2 + ap( k )*x( ix )
17941 y( jy ) = y( jy ) + alpha*temp2
17944 kk = kk + ( n - j + 1 )
17954 SUBROUTINE sspr2 ( UPLO, N, ALPHA, X, INCX, Y, INCY, AP )
17957 INTEGER INCX, INCY, N
17960 REAL AP( * ), X( * ), Y( * )
18049 parameter( zero = 0.0e+0 )
18052 INTEGER I, INFO, IX, IY, J, JX, JY, K, KK, KX, KY
18064 IF ( .NOT.lsame( uplo,
'U' ).AND.
18065 $ .NOT.lsame( uplo,
'L' ) )
THEN 18067 ELSE IF( n.LT.0 )
THEN 18069 ELSE IF( incx.EQ.0 )
THEN 18071 ELSE IF( incy.EQ.0 )
THEN 18074 IF( info.NE.0 )
THEN 18075 CALL xerbla(
'SSPR2 ', info )
18081 IF( ( n.EQ.0 ).OR.( alpha.EQ.zero ) )
18087 IF( ( incx.NE.1 ).OR.( incy.NE.1 ) )
THEN 18088 IF( incx.GT.0 )
THEN 18091 kx = 1 - ( n - 1 )*incx
18093 IF( incy.GT.0 )
THEN 18096 ky = 1 - ( n - 1 )*incy
18106 IF( lsame( uplo,
'U' ) )
THEN 18110 IF( ( incx.EQ.1 ).AND.( incy.EQ.1 ) )
THEN 18112 IF( ( x( j ).NE.zero ).OR.( y( j ).NE.zero ) )
THEN 18113 temp1 = alpha*y( j )
18114 temp2 = alpha*x( j )
18117 ap( k ) = ap( k ) + x( i )*temp1 + y( i )*temp2
18125 IF( ( x( jx ).NE.zero ).OR.( y( jy ).NE.zero ) )
THEN 18126 temp1 = alpha*y( jy )
18127 temp2 = alpha*x( jx )
18130 DO 30, k = kk, kk + j - 1
18131 ap( k ) = ap( k ) + x( ix )*temp1 + y( iy )*temp2
18145 IF( ( incx.EQ.1 ).AND.( incy.EQ.1 ) )
THEN 18147 IF( ( x( j ).NE.zero ).OR.( y( j ).NE.zero ) )
THEN 18148 temp1 = alpha*y( j )
18149 temp2 = alpha*x( j )
18152 ap( k ) = ap( k ) + x( i )*temp1 + y( i )*temp2
18156 kk = kk + n - j + 1
18160 IF( ( x( jx ).NE.zero ).OR.( y( jy ).NE.zero ) )
THEN 18161 temp1 = alpha*y( jy )
18162 temp2 = alpha*x( jx )
18165 DO 70, k = kk, kk + n - j
18166 ap( k ) = ap( k ) + x( ix )*temp1 + y( iy )*temp2
18173 kk = kk + n - j + 1
18183 SUBROUTINE sspr ( UPLO, N, ALPHA, X, INCX, AP )
18189 REAL AP( * ), X( * )
18267 parameter( zero = 0.0e+0 )
18270 INTEGER I, INFO, IX, J, JX, K, KK, KX
18282 IF ( .NOT.lsame( uplo,
'U' ).AND.
18283 $ .NOT.lsame( uplo,
'L' ) )
THEN 18285 ELSE IF( n.LT.0 )
THEN 18287 ELSE IF( incx.EQ.0 )
THEN 18290 IF( info.NE.0 )
THEN 18291 CALL xerbla(
'SSPR ', info )
18297 IF( ( n.EQ.0 ).OR.( alpha.EQ.zero ) )
18302 IF( incx.LE.0 )
THEN 18303 kx = 1 - ( n - 1 )*incx
18304 ELSE IF( incx.NE.1 )
THEN 18312 IF( lsame( uplo,
'U' ) )
THEN 18316 IF( incx.EQ.1 )
THEN 18318 IF( x( j ).NE.zero )
THEN 18319 temp = alpha*x( j )
18322 ap( k ) = ap( k ) + x( i )*temp
18331 IF( x( jx ).NE.zero )
THEN 18332 temp = alpha*x( jx )
18334 DO 30, k = kk, kk + j - 1
18335 ap( k ) = ap( k ) + x( ix )*temp
18347 IF( incx.EQ.1 )
THEN 18349 IF( x( j ).NE.zero )
THEN 18350 temp = alpha*x( j )
18353 ap( k ) = ap( k ) + x( i )*temp
18357 kk = kk + n - j + 1
18362 IF( x( jx ).NE.zero )
THEN 18363 temp = alpha*x( jx )
18365 DO 70, k = kk, kk + n - j
18366 ap( k ) = ap( k ) + x( ix )*temp
18371 kk = kk + n - j + 1
18381 subroutine sswap (n,sx,incx,sy,incy)
18388 real sx(*),sy(*),stemp
18389 integer i,incx,incy,ix,iy,m,mp1,n
18392 if(incx.eq.1.and.incy.eq.1)
go to 20
18399 if(incx.lt.0)ix = (-n+1)*incx + 1
18400 if(incy.lt.0)iy = (-n+1)*incy + 1
18416 if( m .eq. 0 )
go to 40
18422 if( n .lt. 3 )
return 18429 sx(i + 1) = sy(i + 1)
18432 sx(i + 2) = sy(i + 2)
18437 SUBROUTINE ssymm ( SIDE, UPLO, M, N, ALPHA, A, LDA, B, LDB,
18440 CHARACTER*1 SIDE, UPLO
18441 INTEGER M, N, LDA, LDB, LDC
18444 REAL A( lda, * ), B( ldb, * ), C( ldc, * )
18580 INTEGER I, INFO, J, K, NROWA
18584 parameter( one = 1.0e+0, zero = 0.0e+0 )
18590 IF( lsame( side,
'L' ) )
THEN 18595 upper = lsame( uplo,
'U' )
18600 IF( ( .NOT.lsame( side,
'L' ) ).AND.
18601 $ ( .NOT.lsame( side,
'R' ) ) )
THEN 18603 ELSE IF( ( .NOT.upper ).AND.
18604 $ ( .NOT.lsame( uplo,
'L' ) ) )
THEN 18606 ELSE IF( m .LT.0 )
THEN 18608 ELSE IF( n .LT.0 )
THEN 18610 ELSE IF( lda.LT.max( 1, nrowa ) )
THEN 18612 ELSE IF( ldb.LT.max( 1, m ) )
THEN 18614 ELSE IF( ldc.LT.max( 1, m ) )
THEN 18617 IF( info.NE.0 )
THEN 18618 CALL xerbla(
'SSYMM ', info )
18624 IF( ( m.EQ.0 ).OR.( n.EQ.0 ).OR.
18625 $ ( ( alpha.EQ.zero ).AND.( beta.EQ.one ) ) )
18630 IF( alpha.EQ.zero )
THEN 18631 IF( beta.EQ.zero )
THEN 18640 c( i, j ) = beta*c( i, j )
18649 IF( lsame( side,
'L' ) )
THEN 18656 temp1 = alpha*b( i, j )
18658 DO 50, k = 1, i - 1
18659 c( k, j ) = c( k, j ) + temp1 *a( k, i )
18660 temp2 = temp2 + b( k, j )*a( k, i )
18662 IF( beta.EQ.zero )
THEN 18663 c( i, j ) = temp1*a( i, i ) + alpha*temp2
18665 c( i, j ) = beta *c( i, j ) +
18666 $ temp1*a( i, i ) + alpha*temp2
18672 DO 90, i = m, 1, -1
18673 temp1 = alpha*b( i, j )
18675 DO 80, k = i + 1, m
18676 c( k, j ) = c( k, j ) + temp1 *a( k, i )
18677 temp2 = temp2 + b( k, j )*a( k, i )
18679 IF( beta.EQ.zero )
THEN 18680 c( i, j ) = temp1*a( i, i ) + alpha*temp2
18682 c( i, j ) = beta *c( i, j ) +
18683 $ temp1*a( i, i ) + alpha*temp2
18693 temp1 = alpha*a( j, j )
18694 IF( beta.EQ.zero )
THEN 18696 c( i, j ) = temp1*b( i, j )
18700 c( i, j ) = beta*c( i, j ) + temp1*b( i, j )
18703 DO 140, k = 1, j - 1
18705 temp1 = alpha*a( k, j )
18707 temp1 = alpha*a( j, k )
18710 c( i, j ) = c( i, j ) + temp1*b( i, k )
18713 DO 160, k = j + 1, n
18715 temp1 = alpha*a( j, k )
18717 temp1 = alpha*a( k, j )
18720 c( i, j ) = c( i, j ) + temp1*b( i, k )
18731 SUBROUTINE ssymv ( UPLO, N, ALPHA, A, LDA, X, INCX,
18735 INTEGER INCX, INCY, LDA, N
18738 REAL A( lda, * ), X( * ), Y( * )
18832 parameter( one = 1.0e+0, zero = 0.0e+0 )
18835 INTEGER I, INFO, IX, IY, J, JX, JY, KX, KY
18849 IF ( .NOT.lsame( uplo,
'U' ).AND.
18850 $ .NOT.lsame( uplo,
'L' ) )
THEN 18852 ELSE IF( n.LT.0 )
THEN 18854 ELSE IF( lda.LT.max( 1, n ) )
THEN 18856 ELSE IF( incx.EQ.0 )
THEN 18858 ELSE IF( incy.EQ.0 )
THEN 18861 IF( info.NE.0 )
THEN 18862 CALL xerbla(
'SSYMV ', info )
18868 IF( ( n.EQ.0 ).OR.( ( alpha.EQ.zero ).AND.( beta.EQ.one ) ) )
18873 IF( incx.GT.0 )
THEN 18876 kx = 1 - ( n - 1 )*incx
18878 IF( incy.GT.0 )
THEN 18881 ky = 1 - ( n - 1 )*incy
18890 IF( beta.NE.one )
THEN 18891 IF( incy.EQ.1 )
THEN 18892 IF( beta.EQ.zero )
THEN 18898 y( i ) = beta*y( i )
18903 IF( beta.EQ.zero )
THEN 18910 y( iy ) = beta*y( iy )
18916 IF( alpha.EQ.zero )
18918 IF( lsame( uplo,
'U' ) )
THEN 18922 IF( ( incx.EQ.1 ).AND.( incy.EQ.1 ) )
THEN 18924 temp1 = alpha*x( j )
18926 DO 50, i = 1, j - 1
18927 y( i ) = y( i ) + temp1*a( i, j )
18928 temp2 = temp2 + a( i, j )*x( i )
18930 y( j ) = y( j ) + temp1*a( j, j ) + alpha*temp2
18936 temp1 = alpha*x( jx )
18940 DO 70, i = 1, j - 1
18941 y( iy ) = y( iy ) + temp1*a( i, j )
18942 temp2 = temp2 + a( i, j )*x( ix )
18946 y( jy ) = y( jy ) + temp1*a( j, j ) + alpha*temp2
18955 IF( ( incx.EQ.1 ).AND.( incy.EQ.1 ) )
THEN 18957 temp1 = alpha*x( j )
18959 y( j ) = y( j ) + temp1*a( j, j )
18960 DO 90, i = j + 1, n
18961 y( i ) = y( i ) + temp1*a( i, j )
18962 temp2 = temp2 + a( i, j )*x( i )
18964 y( j ) = y( j ) + alpha*temp2
18970 temp1 = alpha*x( jx )
18972 y( jy ) = y( jy ) + temp1*a( j, j )
18975 DO 110, i = j + 1, n
18978 y( iy ) = y( iy ) + temp1*a( i, j )
18979 temp2 = temp2 + a( i, j )*x( ix )
18981 y( jy ) = y( jy ) + alpha*temp2
18993 SUBROUTINE ssyr2 ( UPLO, N, ALPHA, X, INCX, Y, INCY, A, LDA )
18996 INTEGER INCX, INCY, LDA, N
18999 REAL A( lda, * ), X( * ), Y( * )
19091 parameter( zero = 0.0e+0 )
19094 INTEGER I, INFO, IX, IY, J, JX, JY, KX, KY
19108 IF ( .NOT.lsame( uplo,
'U' ).AND.
19109 $ .NOT.lsame( uplo,
'L' ) )
THEN 19111 ELSE IF( n.LT.0 )
THEN 19113 ELSE IF( incx.EQ.0 )
THEN 19115 ELSE IF( incy.EQ.0 )
THEN 19117 ELSE IF( lda.LT.max( 1, n ) )
THEN 19120 IF( info.NE.0 )
THEN 19121 CALL xerbla(
'SSYR2 ', info )
19127 IF( ( n.EQ.0 ).OR.( alpha.EQ.zero ) )
19133 IF( ( incx.NE.1 ).OR.( incy.NE.1 ) )
THEN 19134 IF( incx.GT.0 )
THEN 19137 kx = 1 - ( n - 1 )*incx
19139 IF( incy.GT.0 )
THEN 19142 ky = 1 - ( n - 1 )*incy
19152 IF( lsame( uplo,
'U' ) )
THEN 19156 IF( ( incx.EQ.1 ).AND.( incy.EQ.1 ) )
THEN 19158 IF( ( x( j ).NE.zero ).OR.( y( j ).NE.zero ) )
THEN 19159 temp1 = alpha*y( j )
19160 temp2 = alpha*x( j )
19162 a( i, j ) = a( i, j ) + x( i )*temp1 + y( i )*temp2
19168 IF( ( x( jx ).NE.zero ).OR.( y( jy ).NE.zero ) )
THEN 19169 temp1 = alpha*y( jy )
19170 temp2 = alpha*x( jx )
19174 a( i, j ) = a( i, j ) + x( ix )*temp1
19188 IF( ( incx.EQ.1 ).AND.( incy.EQ.1 ) )
THEN 19190 IF( ( x( j ).NE.zero ).OR.( y( j ).NE.zero ) )
THEN 19191 temp1 = alpha*y( j )
19192 temp2 = alpha*x( j )
19194 a( i, j ) = a( i, j ) + x( i )*temp1 + y( i )*temp2
19200 IF( ( x( jx ).NE.zero ).OR.( y( jy ).NE.zero ) )
THEN 19201 temp1 = alpha*y( jy )
19202 temp2 = alpha*x( jx )
19206 a( i, j ) = a( i, j ) + x( ix )*temp1
19223 SUBROUTINE ssyr2k( UPLO, TRANS, N, K, ALPHA, A, LDA, B, LDB,
19226 CHARACTER*1 UPLO, TRANS
19227 INTEGER N, K, LDA, LDB, LDC
19230 REAL A( lda, * ), B( ldb, * ), C( ldc, * )
19369 INTEGER I, INFO, J, L, NROWA
19373 parameter( one = 1.0e+0, zero = 0.0e+0 )
19379 IF( lsame( trans,
'N' ) )
THEN 19384 upper = lsame( uplo,
'U' )
19387 IF( ( .NOT.upper ).AND.
19388 $ ( .NOT.lsame( uplo ,
'L' ) ) )
THEN 19390 ELSE IF( ( .NOT.lsame( trans,
'N' ) ).AND.
19391 $ ( .NOT.lsame( trans,
'T' ) ).AND.
19392 $ ( .NOT.lsame( trans,
'C' ) ) )
THEN 19394 ELSE IF( n .LT.0 )
THEN 19396 ELSE IF( k .LT.0 )
THEN 19398 ELSE IF( lda.LT.max( 1, nrowa ) )
THEN 19400 ELSE IF( ldb.LT.max( 1, nrowa ) )
THEN 19402 ELSE IF( ldc.LT.max( 1, n ) )
THEN 19405 IF( info.NE.0 )
THEN 19406 CALL xerbla(
'SSYR2K', info )
19413 $ ( ( ( alpha.EQ.zero ).OR.( k.EQ.0 ) ).AND.( beta.EQ.one ) ) )
19418 IF( alpha.EQ.zero )
THEN 19420 IF( beta.EQ.zero )
THEN 19429 c( i, j ) = beta*c( i, j )
19434 IF( beta.EQ.zero )
THEN 19443 c( i, j ) = beta*c( i, j )
19453 IF( lsame( trans,
'N' ) )
THEN 19459 IF( beta.EQ.zero )
THEN 19463 ELSE IF( beta.NE.one )
THEN 19465 c( i, j ) = beta*c( i, j )
19469 IF( ( a( j, l ).NE.zero ).OR.
19470 $ ( b( j, l ).NE.zero ) )
THEN 19471 temp1 = alpha*b( j, l )
19472 temp2 = alpha*a( j, l )
19474 c( i, j ) = c( i, j ) +
19475 $ a( i, l )*temp1 + b( i, l )*temp2
19482 IF( beta.EQ.zero )
THEN 19486 ELSE IF( beta.NE.one )
THEN 19488 c( i, j ) = beta*c( i, j )
19492 IF( ( a( j, l ).NE.zero ).OR.
19493 $ ( b( j, l ).NE.zero ) )
THEN 19494 temp1 = alpha*b( j, l )
19495 temp2 = alpha*a( j, l )
19497 c( i, j ) = c( i, j ) +
19498 $ a( i, l )*temp1 + b( i, l )*temp2
19514 temp1 = temp1 + a( l, i )*b( l, j )
19515 temp2 = temp2 + b( l, i )*a( l, j )
19517 IF( beta.EQ.zero )
THEN 19518 c( i, j ) = alpha*temp1 + alpha*temp2
19520 c( i, j ) = beta *c( i, j ) +
19521 $ alpha*temp1 + alpha*temp2
19531 temp1 = temp1 + a( l, i )*b( l, j )
19532 temp2 = temp2 + b( l, i )*a( l, j )
19534 IF( beta.EQ.zero )
THEN 19535 c( i, j ) = alpha*temp1 + alpha*temp2
19537 c( i, j ) = beta *c( i, j ) +
19538 $ alpha*temp1 + alpha*temp2
19550 SUBROUTINE ssyr ( UPLO, N, ALPHA, X, INCX, A, LDA )
19553 INTEGER INCX, LDA, N
19556 REAL A( lda, * ), X( * )
19637 parameter( zero = 0.0e+0 )
19640 INTEGER I, INFO, IX, J, JX, KX
19654 IF ( .NOT.lsame( uplo,
'U' ).AND.
19655 $ .NOT.lsame( uplo,
'L' ) )
THEN 19657 ELSE IF( n.LT.0 )
THEN 19659 ELSE IF( incx.EQ.0 )
THEN 19661 ELSE IF( lda.LT.max( 1, n ) )
THEN 19664 IF( info.NE.0 )
THEN 19665 CALL xerbla(
'SSYR ', info )
19671 IF( ( n.EQ.0 ).OR.( alpha.EQ.zero ) )
19676 IF( incx.LE.0 )
THEN 19677 kx = 1 - ( n - 1 )*incx
19678 ELSE IF( incx.NE.1 )
THEN 19686 IF( lsame( uplo,
'U' ) )
THEN 19690 IF( incx.EQ.1 )
THEN 19692 IF( x( j ).NE.zero )
THEN 19693 temp = alpha*x( j )
19695 a( i, j ) = a( i, j ) + x( i )*temp
19702 IF( x( jx ).NE.zero )
THEN 19703 temp = alpha*x( jx )
19706 a( i, j ) = a( i, j ) + x( ix )*temp
19717 IF( incx.EQ.1 )
THEN 19719 IF( x( j ).NE.zero )
THEN 19720 temp = alpha*x( j )
19722 a( i, j ) = a( i, j ) + x( i )*temp
19729 IF( x( jx ).NE.zero )
THEN 19730 temp = alpha*x( jx )
19733 a( i, j ) = a( i, j ) + x( ix )*temp
19747 SUBROUTINE ssyrk ( UPLO, TRANS, N, K, ALPHA, A, LDA,
19750 CHARACTER*1 UPLO, TRANS
19751 INTEGER N, K, LDA, LDC
19754 REAL A( lda, * ), C( ldc, * )
19874 INTEGER I, INFO, J, L, NROWA
19878 parameter( one = 1.0e+0, zero = 0.0e+0 )
19884 IF( lsame( trans,
'N' ) )
THEN 19889 upper = lsame( uplo,
'U' )
19892 IF( ( .NOT.upper ).AND.
19893 $ ( .NOT.lsame( uplo ,
'L' ) ) )
THEN 19895 ELSE IF( ( .NOT.lsame( trans,
'N' ) ).AND.
19896 $ ( .NOT.lsame( trans,
'T' ) ).AND.
19897 $ ( .NOT.lsame( trans,
'C' ) ) )
THEN 19899 ELSE IF( n .LT.0 )
THEN 19901 ELSE IF( k .LT.0 )
THEN 19903 ELSE IF( lda.LT.max( 1, nrowa ) )
THEN 19905 ELSE IF( ldc.LT.max( 1, n ) )
THEN 19908 IF( info.NE.0 )
THEN 19909 CALL xerbla(
'SSYRK ', info )
19916 $ ( ( ( alpha.EQ.zero ).OR.( k.EQ.0 ) ).AND.( beta.EQ.one ) ) )
19921 IF( alpha.EQ.zero )
THEN 19923 IF( beta.EQ.zero )
THEN 19932 c( i, j ) = beta*c( i, j )
19937 IF( beta.EQ.zero )
THEN 19946 c( i, j ) = beta*c( i, j )
19956 IF( lsame( trans,
'N' ) )
THEN 19962 IF( beta.EQ.zero )
THEN 19966 ELSE IF( beta.NE.one )
THEN 19968 c( i, j ) = beta*c( i, j )
19972 IF( a( j, l ).NE.zero )
THEN 19973 temp = alpha*a( j, l )
19975 c( i, j ) = c( i, j ) + temp*a( i, l )
19982 IF( beta.EQ.zero )
THEN 19986 ELSE IF( beta.NE.one )
THEN 19988 c( i, j ) = beta*c( i, j )
19992 IF( a( j, l ).NE.zero )
THEN 19993 temp = alpha*a( j, l )
19995 c( i, j ) = c( i, j ) + temp*a( i, l )
20010 temp = temp + a( l, i )*a( l, j )
20012 IF( beta.EQ.zero )
THEN 20013 c( i, j ) = alpha*temp
20015 c( i, j ) = alpha*temp + beta*c( i, j )
20024 temp = temp + a( l, i )*a( l, j )
20026 IF( beta.EQ.zero )
THEN 20027 c( i, j ) = alpha*temp
20029 c( i, j ) = alpha*temp + beta*c( i, j )
20041 SUBROUTINE stbmv ( UPLO, TRANS, DIAG, N, K, A, LDA, X, INCX )
20043 INTEGER INCX, K, LDA, N
20044 CHARACTER*1 DIAG, TRANS, UPLO
20046 REAL A( lda, * ), X( * )
20179 parameter( zero = 0.0e+0 )
20182 INTEGER I, INFO, IX, J, JX, KPLUS1, KX, L
20197 IF ( .NOT.lsame( uplo ,
'U' ).AND.
20198 $ .NOT.lsame( uplo ,
'L' ) )
THEN 20200 ELSE IF( .NOT.lsame( trans,
'N' ).AND.
20201 $ .NOT.lsame( trans,
'T' ).AND.
20202 $ .NOT.lsame( trans,
'C' ) )
THEN 20204 ELSE IF( .NOT.lsame( diag ,
'U' ).AND.
20205 $ .NOT.lsame( diag ,
'N' ) )
THEN 20207 ELSE IF( n.LT.0 )
THEN 20209 ELSE IF( k.LT.0 )
THEN 20211 ELSE IF( lda.LT.( k + 1 ) )
THEN 20213 ELSE IF( incx.EQ.0 )
THEN 20216 IF( info.NE.0 )
THEN 20217 CALL xerbla(
'STBMV ', info )
20226 nounit = lsame( diag,
'N' )
20231 IF( incx.LE.0 )
THEN 20232 kx = 1 - ( n - 1 )*incx
20233 ELSE IF( incx.NE.1 )
THEN 20240 IF( lsame( trans,
'N' ) )
THEN 20244 IF( lsame( uplo,
'U' ) )
THEN 20246 IF( incx.EQ.1 )
THEN 20248 IF( x( j ).NE.zero )
THEN 20251 DO 10, i = max( 1, j - k ), j - 1
20252 x( i ) = x( i ) + temp*a( l + i, j )
20255 $ x( j ) = x( j )*a( kplus1, j )
20261 IF( x( jx ).NE.zero )
THEN 20265 DO 30, i = max( 1, j - k ), j - 1
20266 x( ix ) = x( ix ) + temp*a( l + i, j )
20270 $ x( jx ) = x( jx )*a( kplus1, j )
20278 IF( incx.EQ.1 )
THEN 20279 DO 60, j = n, 1, -1
20280 IF( x( j ).NE.zero )
THEN 20283 DO 50, i = min( n, j + k ), j + 1, -1
20284 x( i ) = x( i ) + temp*a( l + i, j )
20287 $ x( j ) = x( j )*a( 1, j )
20291 kx = kx + ( n - 1 )*incx
20293 DO 80, j = n, 1, -1
20294 IF( x( jx ).NE.zero )
THEN 20298 DO 70, i = min( n, j + k ), j + 1, -1
20299 x( ix ) = x( ix ) + temp*a( l + i, j )
20303 $ x( jx ) = x( jx )*a( 1, j )
20306 IF( ( n - j ).GE.k )
20315 IF( lsame( uplo,
'U' ) )
THEN 20317 IF( incx.EQ.1 )
THEN 20318 DO 100, j = n, 1, -1
20322 $ temp = temp*a( kplus1, j )
20323 DO 90, i = j - 1, max( 1, j - k ), -1
20324 temp = temp + a( l + i, j )*x( i )
20329 kx = kx + ( n - 1 )*incx
20331 DO 120, j = n, 1, -1
20337 $ temp = temp*a( kplus1, j )
20338 DO 110, i = j - 1, max( 1, j - k ), -1
20339 temp = temp + a( l + i, j )*x( ix )
20347 IF( incx.EQ.1 )
THEN 20352 $ temp = temp*a( 1, j )
20353 DO 130, i = j + 1, min( n, j + k )
20354 temp = temp + a( l + i, j )*x( i )
20366 $ temp = temp*a( 1, j )
20367 DO 150, i = j + 1, min( n, j + k )
20368 temp = temp + a( l + i, j )*x( ix )
20383 SUBROUTINE stbsv ( UPLO, TRANS, DIAG, N, K, A, LDA, X, INCX )
20385 INTEGER INCX, K, LDA, N
20386 CHARACTER*1 DIAG, TRANS, UPLO
20388 REAL A( lda, * ), X( * )
20525 parameter( zero = 0.0e+0 )
20528 INTEGER I, INFO, IX, J, JX, KPLUS1, KX, L
20543 IF ( .NOT.lsame( uplo ,
'U' ).AND.
20544 $ .NOT.lsame( uplo ,
'L' ) )
THEN 20546 ELSE IF( .NOT.lsame( trans,
'N' ).AND.
20547 $ .NOT.lsame( trans,
'T' ).AND.
20548 $ .NOT.lsame( trans,
'C' ) )
THEN 20550 ELSE IF( .NOT.lsame( diag ,
'U' ).AND.
20551 $ .NOT.lsame( diag ,
'N' ) )
THEN 20553 ELSE IF( n.LT.0 )
THEN 20555 ELSE IF( k.LT.0 )
THEN 20557 ELSE IF( lda.LT.( k + 1 ) )
THEN 20559 ELSE IF( incx.EQ.0 )
THEN 20562 IF( info.NE.0 )
THEN 20563 CALL xerbla(
'STBSV ', info )
20572 nounit = lsame( diag,
'N' )
20577 IF( incx.LE.0 )
THEN 20578 kx = 1 - ( n - 1 )*incx
20579 ELSE IF( incx.NE.1 )
THEN 20586 IF( lsame( trans,
'N' ) )
THEN 20590 IF( lsame( uplo,
'U' ) )
THEN 20592 IF( incx.EQ.1 )
THEN 20593 DO 20, j = n, 1, -1
20594 IF( x( j ).NE.zero )
THEN 20597 $ x( j ) = x( j )/a( kplus1, j )
20599 DO 10, i = j - 1, max( 1, j - k ), -1
20600 x( i ) = x( i ) - temp*a( l + i, j )
20605 kx = kx + ( n - 1 )*incx
20607 DO 40, j = n, 1, -1
20609 IF( x( jx ).NE.zero )
THEN 20613 $ x( jx ) = x( jx )/a( kplus1, j )
20615 DO 30, i = j - 1, max( 1, j - k ), -1
20616 x( ix ) = x( ix ) - temp*a( l + i, j )
20624 IF( incx.EQ.1 )
THEN 20626 IF( x( j ).NE.zero )
THEN 20629 $ x( j ) = x( j )/a( 1, j )
20631 DO 50, i = j + 1, min( n, j + k )
20632 x( i ) = x( i ) - temp*a( l + i, j )
20640 IF( x( jx ).NE.zero )
THEN 20644 $ x( jx ) = x( jx )/a( 1, j )
20646 DO 70, i = j + 1, min( n, j + k )
20647 x( ix ) = x( ix ) - temp*a( l + i, j )
20659 IF( lsame( uplo,
'U' ) )
THEN 20661 IF( incx.EQ.1 )
THEN 20665 DO 90, i = max( 1, j - k ), j - 1
20666 temp = temp - a( l + i, j )*x( i )
20669 $ temp = temp/a( kplus1, j )
20678 DO 110, i = max( 1, j - k ), j - 1
20679 temp = temp - a( l + i, j )*x( ix )
20683 $ temp = temp/a( kplus1, j )
20691 IF( incx.EQ.1 )
THEN 20692 DO 140, j = n, 1, -1
20695 DO 130, i = min( n, j + k ), j + 1, -1
20696 temp = temp - a( l + i, j )*x( i )
20699 $ temp = temp/a( 1, j )
20703 kx = kx + ( n - 1 )*incx
20705 DO 160, j = n, 1, -1
20709 DO 150, i = min( n, j + k ), j + 1, -1
20710 temp = temp - a( l + i, j )*x( ix )
20714 $ temp = temp/a( 1, j )
20717 IF( ( n - j ).GE.k )
20729 SUBROUTINE stpmv ( UPLO, TRANS, DIAG, N, AP, X, INCX )
20732 CHARACTER*1 DIAG, TRANS, UPLO
20734 REAL AP( * ), X( * )
20827 parameter( zero = 0.0e+0 )
20830 INTEGER I, INFO, IX, J, JX, K, KK, KX
20843 IF ( .NOT.lsame( uplo ,
'U' ).AND.
20844 $ .NOT.lsame( uplo ,
'L' ) )
THEN 20846 ELSE IF( .NOT.lsame( trans,
'N' ).AND.
20847 $ .NOT.lsame( trans,
'T' ).AND.
20848 $ .NOT.lsame( trans,
'C' ) )
THEN 20850 ELSE IF( .NOT.lsame( diag ,
'U' ).AND.
20851 $ .NOT.lsame( diag ,
'N' ) )
THEN 20853 ELSE IF( n.LT.0 )
THEN 20855 ELSE IF( incx.EQ.0 )
THEN 20858 IF( info.NE.0 )
THEN 20859 CALL xerbla(
'STPMV ', info )
20868 nounit = lsame( diag,
'N' )
20873 IF( incx.LE.0 )
THEN 20874 kx = 1 - ( n - 1 )*incx
20875 ELSE IF( incx.NE.1 )
THEN 20882 IF( lsame( trans,
'N' ) )
THEN 20886 IF( lsame( uplo,
'U' ) )
THEN 20888 IF( incx.EQ.1 )
THEN 20890 IF( x( j ).NE.zero )
THEN 20893 DO 10, i = 1, j - 1
20894 x( i ) = x( i ) + temp*ap( k )
20898 $ x( j ) = x( j )*ap( kk + j - 1 )
20905 IF( x( jx ).NE.zero )
THEN 20908 DO 30, k = kk, kk + j - 2
20909 x( ix ) = x( ix ) + temp*ap( k )
20913 $ x( jx ) = x( jx )*ap( kk + j - 1 )
20920 kk = ( n*( n + 1 ) )/2
20921 IF( incx.EQ.1 )
THEN 20922 DO 60, j = n, 1, -1
20923 IF( x( j ).NE.zero )
THEN 20926 DO 50, i = n, j + 1, -1
20927 x( i ) = x( i ) + temp*ap( k )
20931 $ x( j ) = x( j )*ap( kk - n + j )
20933 kk = kk - ( n - j + 1 )
20936 kx = kx + ( n - 1 )*incx
20938 DO 80, j = n, 1, -1
20939 IF( x( jx ).NE.zero )
THEN 20942 DO 70, k = kk, kk - ( n - ( j + 1 ) ), -1
20943 x( ix ) = x( ix ) + temp*ap( k )
20947 $ x( jx ) = x( jx )*ap( kk - n + j )
20950 kk = kk - ( n - j + 1 )
20958 IF( lsame( uplo,
'U' ) )
THEN 20959 kk = ( n*( n + 1 ) )/2
20960 IF( incx.EQ.1 )
THEN 20961 DO 100, j = n, 1, -1
20964 $ temp = temp*ap( kk )
20966 DO 90, i = j - 1, 1, -1
20967 temp = temp + ap( k )*x( i )
20974 jx = kx + ( n - 1 )*incx
20975 DO 120, j = n, 1, -1
20979 $ temp = temp*ap( kk )
20980 DO 110, k = kk - 1, kk - j + 1, -1
20982 temp = temp + ap( k )*x( ix )
20991 IF( incx.EQ.1 )
THEN 20995 $ temp = temp*ap( kk )
20997 DO 130, i = j + 1, n
20998 temp = temp + ap( k )*x( i )
21002 kk = kk + ( n - j + 1 )
21010 $ temp = temp*ap( kk )
21011 DO 150, k = kk + 1, kk + n - j
21013 temp = temp + ap( k )*x( ix )
21017 kk = kk + ( n - j + 1 )
21028 SUBROUTINE stpsv ( UPLO, TRANS, DIAG, N, AP, X, INCX )
21031 CHARACTER*1 DIAG, TRANS, UPLO
21033 REAL AP( * ), X( * )
21129 parameter( zero = 0.0e+0 )
21132 INTEGER I, INFO, IX, J, JX, K, KK, KX
21145 IF ( .NOT.lsame( uplo ,
'U' ).AND.
21146 $ .NOT.lsame( uplo ,
'L' ) )
THEN 21148 ELSE IF( .NOT.lsame( trans,
'N' ).AND.
21149 $ .NOT.lsame( trans,
'T' ).AND.
21150 $ .NOT.lsame( trans,
'C' ) )
THEN 21152 ELSE IF( .NOT.lsame( diag ,
'U' ).AND.
21153 $ .NOT.lsame( diag ,
'N' ) )
THEN 21155 ELSE IF( n.LT.0 )
THEN 21157 ELSE IF( incx.EQ.0 )
THEN 21160 IF( info.NE.0 )
THEN 21161 CALL xerbla(
'STPSV ', info )
21170 nounit = lsame( diag,
'N' )
21175 IF( incx.LE.0 )
THEN 21176 kx = 1 - ( n - 1 )*incx
21177 ELSE IF( incx.NE.1 )
THEN 21184 IF( lsame( trans,
'N' ) )
THEN 21188 IF( lsame( uplo,
'U' ) )
THEN 21189 kk = ( n*( n + 1 ) )/2
21190 IF( incx.EQ.1 )
THEN 21191 DO 20, j = n, 1, -1
21192 IF( x( j ).NE.zero )
THEN 21194 $ x( j ) = x( j )/ap( kk )
21197 DO 10, i = j - 1, 1, -1
21198 x( i ) = x( i ) - temp*ap( k )
21205 jx = kx + ( n - 1 )*incx
21206 DO 40, j = n, 1, -1
21207 IF( x( jx ).NE.zero )
THEN 21209 $ x( jx ) = x( jx )/ap( kk )
21212 DO 30, k = kk - 1, kk - j + 1, -1
21214 x( ix ) = x( ix ) - temp*ap( k )
21223 IF( incx.EQ.1 )
THEN 21225 IF( x( j ).NE.zero )
THEN 21227 $ x( j ) = x( j )/ap( kk )
21230 DO 50, i = j + 1, n
21231 x( i ) = x( i ) - temp*ap( k )
21235 kk = kk + ( n - j + 1 )
21240 IF( x( jx ).NE.zero )
THEN 21242 $ x( jx ) = x( jx )/ap( kk )
21245 DO 70, k = kk + 1, kk + n - j
21247 x( ix ) = x( ix ) - temp*ap( k )
21251 kk = kk + ( n - j + 1 )
21259 IF( lsame( uplo,
'U' ) )
THEN 21261 IF( incx.EQ.1 )
THEN 21265 DO 90, i = 1, j - 1
21266 temp = temp - ap( k )*x( i )
21270 $ temp = temp/ap( kk + j - 1 )
21279 DO 110, k = kk, kk + j - 2
21280 temp = temp - ap( k )*x( ix )
21284 $ temp = temp/ap( kk + j - 1 )
21291 kk = ( n*( n + 1 ) )/2
21292 IF( incx.EQ.1 )
THEN 21293 DO 140, j = n, 1, -1
21296 DO 130, i = n, j + 1, -1
21297 temp = temp - ap( k )*x( i )
21301 $ temp = temp/ap( kk - n + j )
21303 kk = kk - ( n - j + 1 )
21306 kx = kx + ( n - 1 )*incx
21308 DO 160, j = n, 1, -1
21311 DO 150, k = kk, kk - ( n - ( j + 1 ) ), -1
21312 temp = temp - ap( k )*x( ix )
21316 $ temp = temp/ap( kk - n + j )
21319 kk = kk - (n - j + 1 )
21330 SUBROUTINE strmm ( SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA,
21333 CHARACTER*1 SIDE, UPLO, TRANSA, DIAG
21334 INTEGER M, N, LDA, LDB
21337 REAL A( lda, * ), B( ldb, * )
21464 LOGICAL LSIDE, NOUNIT, UPPER
21465 INTEGER I, INFO, J, K, NROWA
21469 parameter( one = 1.0e+0, zero = 0.0e+0 )
21475 lside = lsame( side ,
'L' )
21481 nounit = lsame( diag ,
'N' )
21482 upper = lsame( uplo ,
'U' )
21485 IF( ( .NOT.lside ).AND.
21486 $ ( .NOT.lsame( side ,
'R' ) ) )
THEN 21488 ELSE IF( ( .NOT.upper ).AND.
21489 $ ( .NOT.lsame( uplo ,
'L' ) ) )
THEN 21491 ELSE IF( ( .NOT.lsame( transa,
'N' ) ).AND.
21492 $ ( .NOT.lsame( transa,
'T' ) ).AND.
21493 $ ( .NOT.lsame( transa,
'C' ) ) )
THEN 21495 ELSE IF( ( .NOT.lsame( diag ,
'U' ) ).AND.
21496 $ ( .NOT.lsame( diag ,
'N' ) ) )
THEN 21498 ELSE IF( m .LT.0 )
THEN 21500 ELSE IF( n .LT.0 )
THEN 21502 ELSE IF( lda.LT.max( 1, nrowa ) )
THEN 21504 ELSE IF( ldb.LT.max( 1, m ) )
THEN 21507 IF( info.NE.0 )
THEN 21508 CALL xerbla(
'STRMM ', info )
21519 IF( alpha.EQ.zero )
THEN 21531 IF( lsame( transa,
'N' ) )
THEN 21538 IF( b( k, j ).NE.zero )
THEN 21539 temp = alpha*b( k, j )
21540 DO 30, i = 1, k - 1
21541 b( i, j ) = b( i, j ) + temp*a( i, k )
21544 $ temp = temp*a( k, k )
21552 IF( b( k, j ).NE.zero )
THEN 21553 temp = alpha*b( k, j )
21556 $ b( k, j ) = b( k, j )*a( k, k )
21557 DO 60, i = k + 1, m
21558 b( i, j ) = b( i, j ) + temp*a( i, k )
21570 DO 100, i = m, 1, -1
21573 $ temp = temp*a( i, i )
21574 DO 90, k = 1, i - 1
21575 temp = temp + a( k, i )*b( k, j )
21577 b( i, j ) = alpha*temp
21585 $ temp = temp*a( i, i )
21586 DO 120, k = i + 1, m
21587 temp = temp + a( k, i )*b( k, j )
21589 b( i, j ) = alpha*temp
21595 IF( lsame( transa,
'N' ) )
THEN 21600 DO 180, j = n, 1, -1
21603 $ temp = temp*a( j, j )
21605 b( i, j ) = temp*b( i, j )
21607 DO 170, k = 1, j - 1
21608 IF( a( k, j ).NE.zero )
THEN 21609 temp = alpha*a( k, j )
21611 b( i, j ) = b( i, j ) + temp*b( i, k )
21620 $ temp = temp*a( j, j )
21622 b( i, j ) = temp*b( i, j )
21624 DO 210, k = j + 1, n
21625 IF( a( k, j ).NE.zero )
THEN 21626 temp = alpha*a( k, j )
21628 b( i, j ) = b( i, j ) + temp*b( i, k )
21640 DO 240, j = 1, k - 1
21641 IF( a( j, k ).NE.zero )
THEN 21642 temp = alpha*a( j, k )
21644 b( i, j ) = b( i, j ) + temp*b( i, k )
21650 $ temp = temp*a( k, k )
21651 IF( temp.NE.one )
THEN 21653 b( i, k ) = temp*b( i, k )
21658 DO 300, k = n, 1, -1
21659 DO 280, j = k + 1, n
21660 IF( a( j, k ).NE.zero )
THEN 21661 temp = alpha*a( j, k )
21663 b( i, j ) = b( i, j ) + temp*b( i, k )
21669 $ temp = temp*a( k, k )
21670 IF( temp.NE.one )
THEN 21672 b( i, k ) = temp*b( i, k )
21685 SUBROUTINE strmv ( UPLO, TRANS, DIAG, N, A, LDA, X, INCX )
21687 INTEGER INCX, LDA, N
21688 CHARACTER*1 DIAG, TRANS, UPLO
21690 REAL A( lda, * ), X( * )
21786 parameter( zero = 0.0e+0 )
21789 INTEGER I, INFO, IX, J, JX, KX
21804 IF ( .NOT.lsame( uplo ,
'U' ).AND.
21805 $ .NOT.lsame( uplo ,
'L' ) )
THEN 21807 ELSE IF( .NOT.lsame( trans,
'N' ).AND.
21808 $ .NOT.lsame( trans,
'T' ).AND.
21809 $ .NOT.lsame( trans,
'C' ) )
THEN 21811 ELSE IF( .NOT.lsame( diag ,
'U' ).AND.
21812 $ .NOT.lsame( diag ,
'N' ) )
THEN 21814 ELSE IF( n.LT.0 )
THEN 21816 ELSE IF( lda.LT.max( 1, n ) )
THEN 21818 ELSE IF( incx.EQ.0 )
THEN 21821 IF( info.NE.0 )
THEN 21822 CALL xerbla(
'STRMV ', info )
21831 nounit = lsame( diag,
'N' )
21836 IF( incx.LE.0 )
THEN 21837 kx = 1 - ( n - 1 )*incx
21838 ELSE IF( incx.NE.1 )
THEN 21845 IF( lsame( trans,
'N' ) )
THEN 21849 IF( lsame( uplo,
'U' ) )
THEN 21850 IF( incx.EQ.1 )
THEN 21852 IF( x( j ).NE.zero )
THEN 21854 DO 10, i = 1, j - 1
21855 x( i ) = x( i ) + temp*a( i, j )
21858 $ x( j ) = x( j )*a( j, j )
21864 IF( x( jx ).NE.zero )
THEN 21867 DO 30, i = 1, j - 1
21868 x( ix ) = x( ix ) + temp*a( i, j )
21872 $ x( jx ) = x( jx )*a( j, j )
21878 IF( incx.EQ.1 )
THEN 21879 DO 60, j = n, 1, -1
21880 IF( x( j ).NE.zero )
THEN 21882 DO 50, i = n, j + 1, -1
21883 x( i ) = x( i ) + temp*a( i, j )
21886 $ x( j ) = x( j )*a( j, j )
21890 kx = kx + ( n - 1 )*incx
21892 DO 80, j = n, 1, -1
21893 IF( x( jx ).NE.zero )
THEN 21896 DO 70, i = n, j + 1, -1
21897 x( ix ) = x( ix ) + temp*a( i, j )
21901 $ x( jx ) = x( jx )*a( j, j )
21911 IF( lsame( uplo,
'U' ) )
THEN 21912 IF( incx.EQ.1 )
THEN 21913 DO 100, j = n, 1, -1
21916 $ temp = temp*a( j, j )
21917 DO 90, i = j - 1, 1, -1
21918 temp = temp + a( i, j )*x( i )
21923 jx = kx + ( n - 1 )*incx
21924 DO 120, j = n, 1, -1
21928 $ temp = temp*a( j, j )
21929 DO 110, i = j - 1, 1, -1
21931 temp = temp + a( i, j )*x( ix )
21938 IF( incx.EQ.1 )
THEN 21942 $ temp = temp*a( j, j )
21943 DO 130, i = j + 1, n
21944 temp = temp + a( i, j )*x( i )
21954 $ temp = temp*a( j, j )
21955 DO 150, i = j + 1, n
21957 temp = temp + a( i, j )*x( ix )
21971 SUBROUTINE strsm ( SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA,
21974 CHARACTER*1 SIDE, UPLO, TRANSA, DIAG
21975 INTEGER M, N, LDA, LDB
21978 REAL A( lda, * ), B( ldb, * )
22108 LOGICAL LSIDE, NOUNIT, UPPER
22109 INTEGER I, INFO, J, K, NROWA
22113 parameter( one = 1.0e+0, zero = 0.0e+0 )
22119 lside = lsame( side ,
'L' )
22125 nounit = lsame( diag ,
'N' )
22126 upper = lsame( uplo ,
'U' )
22129 IF( ( .NOT.lside ).AND.
22130 $ ( .NOT.lsame( side ,
'R' ) ) )
THEN 22132 ELSE IF( ( .NOT.upper ).AND.
22133 $ ( .NOT.lsame( uplo ,
'L' ) ) )
THEN 22135 ELSE IF( ( .NOT.lsame( transa,
'N' ) ).AND.
22136 $ ( .NOT.lsame( transa,
'T' ) ).AND.
22137 $ ( .NOT.lsame( transa,
'C' ) ) )
THEN 22139 ELSE IF( ( .NOT.lsame( diag ,
'U' ) ).AND.
22140 $ ( .NOT.lsame( diag ,
'N' ) ) )
THEN 22142 ELSE IF( m .LT.0 )
THEN 22144 ELSE IF( n .LT.0 )
THEN 22146 ELSE IF( lda.LT.max( 1, nrowa ) )
THEN 22148 ELSE IF( ldb.LT.max( 1, m ) )
THEN 22151 IF( info.NE.0 )
THEN 22152 CALL xerbla(
'STRSM ', info )
22163 IF( alpha.EQ.zero )
THEN 22175 IF( lsame( transa,
'N' ) )
THEN 22181 IF( alpha.NE.one )
THEN 22183 b( i, j ) = alpha*b( i, j )
22186 DO 50, k = m, 1, -1
22187 IF( b( k, j ).NE.zero )
THEN 22189 $ b( k, j ) = b( k, j )/a( k, k )
22190 DO 40, i = 1, k - 1
22191 b( i, j ) = b( i, j ) - b( k, j )*a( i, k )
22198 IF( alpha.NE.one )
THEN 22200 b( i, j ) = alpha*b( i, j )
22204 IF( b( k, j ).NE.zero )
THEN 22206 $ b( k, j ) = b( k, j )/a( k, k )
22207 DO 80, i = k + 1, m
22208 b( i, j ) = b( i, j ) - b( k, j )*a( i, k )
22221 temp = alpha*b( i, j )
22222 DO 110, k = 1, i - 1
22223 temp = temp - a( k, i )*b( k, j )
22226 $ temp = temp/a( i, i )
22232 DO 150, i = m, 1, -1
22233 temp = alpha*b( i, j )
22234 DO 140, k = i + 1, m
22235 temp = temp - a( k, i )*b( k, j )
22238 $ temp = temp/a( i, i )
22245 IF( lsame( transa,
'N' ) )
THEN 22251 IF( alpha.NE.one )
THEN 22253 b( i, j ) = alpha*b( i, j )
22256 DO 190, k = 1, j - 1
22257 IF( a( k, j ).NE.zero )
THEN 22259 b( i, j ) = b( i, j ) - a( k, j )*b( i, k )
22264 temp = one/a( j, j )
22266 b( i, j ) = temp*b( i, j )
22271 DO 260, j = n, 1, -1
22272 IF( alpha.NE.one )
THEN 22274 b( i, j ) = alpha*b( i, j )
22277 DO 240, k = j + 1, n
22278 IF( a( k, j ).NE.zero )
THEN 22280 b( i, j ) = b( i, j ) - a( k, j )*b( i, k )
22285 temp = one/a( j, j )
22287 b( i, j ) = temp*b( i, j )
22297 DO 310, k = n, 1, -1
22299 temp = one/a( k, k )
22301 b( i, k ) = temp*b( i, k )
22304 DO 290, j = 1, k - 1
22305 IF( a( j, k ).NE.zero )
THEN 22308 b( i, j ) = b( i, j ) - temp*b( i, k )
22312 IF( alpha.NE.one )
THEN 22314 b( i, k ) = alpha*b( i, k )
22321 temp = one/a( k, k )
22323 b( i, k ) = temp*b( i, k )
22326 DO 340, j = k + 1, n
22327 IF( a( j, k ).NE.zero )
THEN 22330 b( i, j ) = b( i, j ) - temp*b( i, k )
22334 IF( alpha.NE.one )
THEN 22336 b( i, k ) = alpha*b( i, k )
22349 SUBROUTINE strsv ( UPLO, TRANS, DIAG, N, A, LDA, X, INCX )
22351 INTEGER INCX, LDA, N
22352 CHARACTER*1 DIAG, TRANS, UPLO
22354 REAL A( lda, * ), X( * )
22453 parameter( zero = 0.0e+0 )
22456 INTEGER I, INFO, IX, J, JX, KX
22471 IF ( .NOT.lsame( uplo ,
'U' ).AND.
22472 $ .NOT.lsame( uplo ,
'L' ) )
THEN 22474 ELSE IF( .NOT.lsame( trans,
'N' ).AND.
22475 $ .NOT.lsame( trans,
'T' ).AND.
22476 $ .NOT.lsame( trans,
'C' ) )
THEN 22478 ELSE IF( .NOT.lsame( diag ,
'U' ).AND.
22479 $ .NOT.lsame( diag ,
'N' ) )
THEN 22481 ELSE IF( n.LT.0 )
THEN 22483 ELSE IF( lda.LT.max( 1, n ) )
THEN 22485 ELSE IF( incx.EQ.0 )
THEN 22488 IF( info.NE.0 )
THEN 22489 CALL xerbla(
'STRSV ', info )
22498 nounit = lsame( diag,
'N' )
22503 IF( incx.LE.0 )
THEN 22504 kx = 1 - ( n - 1 )*incx
22505 ELSE IF( incx.NE.1 )
THEN 22512 IF( lsame( trans,
'N' ) )
THEN 22516 IF( lsame( uplo,
'U' ) )
THEN 22517 IF( incx.EQ.1 )
THEN 22518 DO 20, j = n, 1, -1
22519 IF( x( j ).NE.zero )
THEN 22521 $ x( j ) = x( j )/a( j, j )
22523 DO 10, i = j - 1, 1, -1
22524 x( i ) = x( i ) - temp*a( i, j )
22529 jx = kx + ( n - 1 )*incx
22530 DO 40, j = n, 1, -1
22531 IF( x( jx ).NE.zero )
THEN 22533 $ x( jx ) = x( jx )/a( j, j )
22536 DO 30, i = j - 1, 1, -1
22538 x( ix ) = x( ix ) - temp*a( i, j )
22545 IF( incx.EQ.1 )
THEN 22547 IF( x( j ).NE.zero )
THEN 22549 $ x( j ) = x( j )/a( j, j )
22551 DO 50, i = j + 1, n
22552 x( i ) = x( i ) - temp*a( i, j )
22559 IF( x( jx ).NE.zero )
THEN 22561 $ x( jx ) = x( jx )/a( j, j )
22564 DO 70, i = j + 1, n
22566 x( ix ) = x( ix ) - temp*a( i, j )
22577 IF( lsame( uplo,
'U' ) )
THEN 22578 IF( incx.EQ.1 )
THEN 22581 DO 90, i = 1, j - 1
22582 temp = temp - a( i, j )*x( i )
22585 $ temp = temp/a( j, j )
22593 DO 110, i = 1, j - 1
22594 temp = temp - a( i, j )*x( ix )
22598 $ temp = temp/a( j, j )
22604 IF( incx.EQ.1 )
THEN 22605 DO 140, j = n, 1, -1
22607 DO 130, i = n, j + 1, -1
22608 temp = temp - a( i, j )*x( i )
22611 $ temp = temp/a( j, j )
22615 kx = kx + ( n - 1 )*incx
22617 DO 160, j = n, 1, -1
22620 DO 150, i = n, j + 1, -1
22621 temp = temp - a( i, j )*x( ix )
22625 $ temp = temp/a( j, j )
22638 SUBROUTINE xerbla( SRNAME, INFO )
22671 WRITE( *, fmt = 9999 )srname, info
22675 9999
FORMAT(
' ** On entry to ', a6,
' parameter number ', i2,
' had ',
22676 $
'an illegal value' )
22681 subroutine zaxpy(n,za,zx,incx,zy,incy)
22687 double complex zx(*),zy(*),za
22688 integer i,incx,incy,ix,iy,n
22689 double precision dcabs1
22691 if (dcabs1(za) .eq. 0.0d0)
return 22692 if (incx.eq.1.and.incy.eq.1)
go to 20
22699 if(incx.lt.0)ix = (-n+1)*incx + 1
22700 if(incy.lt.0)iy = (-n+1)*incy + 1
22702 zy(iy) = zy(iy) + za*zx(ix)
22711 zy(i) = zy(i) + za*zx(i)
22715 subroutine zcopy(n,zx,incx,zy,incy)
22721 double complex zx(*),zy(*)
22722 integer i,incx,incy,ix,iy,n
22725 if(incx.eq.1.and.incy.eq.1)
go to 20
22732 if(incx.lt.0)ix = (-n+1)*incx + 1
22733 if(incy.lt.0)iy = (-n+1)*incy + 1
22748 double complex function zdotc(n,zx,incx,zy,incy)
22754 double complex zx(*),zy(*),ztemp
22755 integer i,incx,incy,ix,iy,n
22756 ztemp = (0.0d0,0.0d0)
22757 zdotc = (0.0d0,0.0d0)
22759 if(incx.eq.1.and.incy.eq.1)
go to 20
22766 if(incx.lt.0)ix = (-n+1)*incx + 1
22767 if(incy.lt.0)iy = (-n+1)*incy + 1
22769 ztemp = ztemp + dconjg(zx(ix))*zy(iy)
22779 ztemp = ztemp + dconjg(zx(i))*zy(i)
22784 double complex function zdotu(n,zx,incx,zy,incy)
22790 double complex zx(*),zy(*),ztemp
22791 integer i,incx,incy,ix,iy,n
22792 ztemp = (0.0d0,0.0d0)
22793 zdotu = (0.0d0,0.0d0)
22795 if(incx.eq.1.and.incy.eq.1)
go to 20
22802 if(incx.lt.0)ix = (-n+1)*incx + 1
22803 if(incy.lt.0)iy = (-n+1)*incy + 1
22805 ztemp = ztemp + zx(ix)*zy(iy)
22815 ztemp = ztemp + zx(i)*zy(i)
22820 subroutine zdrot (n,zx,incx,zy,incy,c,s)
22826 double complex zx(1),zy(1),ztemp
22827 double precision c,s
22828 integer i,incx,incy,ix,iy,n
22831 if(incx.eq.1.and.incy.eq.1)
go to 20
22838 if(incx.lt.0)ix = (-n+1)*incx + 1
22839 if(incy.lt.0)iy = (-n+1)*incy + 1
22841 ztemp = c*zx(ix) + s*zy(iy)
22842 zy(iy) = c*zy(iy) - s*zx(ix)
22852 ztemp = c*zx(i) + s*zy(i)
22853 zy(i) = c*zy(i) - s*zx(i)
22858 subroutine zdscal(n,da,zx,incx)
22865 double complex zx(*)
22866 double precision da
22867 integer i,incx,ix,n
22869 if( n.le.0 .or. incx.le.0 )
return 22870 if(incx.eq.1)
go to 20
22876 zx(ix) = dcmplx(da,0.0d0)*zx(ix)
22884 zx(i) = dcmplx(da,0.0d0)*zx(i)
22888 SUBROUTINE zgbmv ( TRANS, M, N, KL, KU, ALPHA, A, LDA, X, INCX,
22891 COMPLEX*16 ALPHA, BETA
22892 INTEGER INCX, INCY, KL, KU, LDA, M, N
22895 COMPLEX*16 A( lda, * ), X( * ), Y( * )
23020 parameter( one = ( 1.0d+0, 0.0d+0 ) )
23022 parameter( zero = ( 0.0d+0, 0.0d+0 ) )
23025 INTEGER I, INFO, IX, IY, J, JX, JY, K, KUP1, KX, KY,
23034 INTRINSIC dconjg, max, min
23041 IF ( .NOT.lsame( trans,
'N' ).AND.
23042 $ .NOT.lsame( trans,
'T' ).AND.
23043 $ .NOT.lsame( trans,
'C' ) )
THEN 23045 ELSE IF( m.LT.0 )
THEN 23047 ELSE IF( n.LT.0 )
THEN 23049 ELSE IF( kl.LT.0 )
THEN 23051 ELSE IF( ku.LT.0 )
THEN 23053 ELSE IF( lda.LT.( kl + ku + 1 ) )
THEN 23055 ELSE IF( incx.EQ.0 )
THEN 23057 ELSE IF( incy.EQ.0 )
THEN 23060 IF( info.NE.0 )
THEN 23061 CALL xerbla(
'ZGBMV ', info )
23067 IF( ( m.EQ.0 ).OR.( n.EQ.0 ).OR.
23068 $ ( ( alpha.EQ.zero ).AND.( beta.EQ.one ) ) )
23071 noconj = lsame( trans,
'T' )
23076 IF( lsame( trans,
'N' ) )
THEN 23083 IF( incx.GT.0 )
THEN 23086 kx = 1 - ( lenx - 1 )*incx
23088 IF( incy.GT.0 )
THEN 23091 ky = 1 - ( leny - 1 )*incy
23099 IF( beta.NE.one )
THEN 23100 IF( incy.EQ.1 )
THEN 23101 IF( beta.EQ.zero )
THEN 23107 y( i ) = beta*y( i )
23112 IF( beta.EQ.zero )
THEN 23119 y( iy ) = beta*y( iy )
23125 IF( alpha.EQ.zero )
23128 IF( lsame( trans,
'N' ) )
THEN 23133 IF( incy.EQ.1 )
THEN 23135 IF( x( jx ).NE.zero )
THEN 23136 temp = alpha*x( jx )
23138 DO 50, i = max( 1, j - ku ), min( m, j + kl )
23139 y( i ) = y( i ) + temp*a( k + i, j )
23146 IF( x( jx ).NE.zero )
THEN 23147 temp = alpha*x( jx )
23150 DO 70, i = max( 1, j - ku ), min( m, j + kl )
23151 y( iy ) = y( iy ) + temp*a( k + i, j )
23165 IF( incx.EQ.1 )
THEN 23170 DO 90, i = max( 1, j - ku ), min( m, j + kl )
23171 temp = temp + a( k + i, j )*x( i )
23174 DO 100, i = max( 1, j - ku ), min( m, j + kl )
23175 temp = temp + dconjg( a( k + i, j ) )*x( i )
23178 y( jy ) = y( jy ) + alpha*temp
23187 DO 120, i = max( 1, j - ku ), min( m, j + kl )
23188 temp = temp + a( k + i, j )*x( ix )
23192 DO 130, i = max( 1, j - ku ), min( m, j + kl )
23193 temp = temp + dconjg( a( k + i, j ) )*x( ix )
23197 y( jy ) = y( jy ) + alpha*temp
23210 SUBROUTINE zgemm ( TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB,
23213 CHARACTER*1 TRANSA, TRANSB
23214 INTEGER M, N, K, LDA, LDB, LDC
23215 COMPLEX*16 ALPHA, BETA
23217 COMPLEX*16 A( lda, * ), B( ldb, * ), C( ldc, * )
23346 INTRINSIC dconjg, max
23348 LOGICAL CONJA, CONJB, NOTA, NOTB
23349 INTEGER I, INFO, J, L, NCOLA, NROWA, NROWB
23353 parameter( one = ( 1.0d+0, 0.0d+0 ) )
23355 parameter( zero = ( 0.0d+0, 0.0d+0 ) )
23365 nota = lsame( transa,
'N' )
23366 notb = lsame( transb,
'N' )
23367 conja = lsame( transa,
'C' )
23368 conjb = lsame( transb,
'C' )
23385 IF( ( .NOT.nota ).AND.
23386 $ ( .NOT.conja ).AND.
23387 $ ( .NOT.lsame( transa,
'T' ) ) )
THEN 23389 ELSE IF( ( .NOT.notb ).AND.
23390 $ ( .NOT.conjb ).AND.
23391 $ ( .NOT.lsame( transb,
'T' ) ) )
THEN 23393 ELSE IF( m .LT.0 )
THEN 23395 ELSE IF( n .LT.0 )
THEN 23397 ELSE IF( k .LT.0 )
THEN 23399 ELSE IF( lda.LT.max( 1, nrowa ) )
THEN 23401 ELSE IF( ldb.LT.max( 1, nrowb ) )
THEN 23403 ELSE IF( ldc.LT.max( 1, m ) )
THEN 23406 IF( info.NE.0 )
THEN 23407 CALL xerbla(
'ZGEMM ', info )
23413 IF( ( m.EQ.0 ).OR.( n.EQ.0 ).OR.
23414 $ ( ( ( alpha.EQ.zero ).OR.( k.EQ.0 ) ).AND.( beta.EQ.one ) ) )
23419 IF( alpha.EQ.zero )
THEN 23420 IF( beta.EQ.zero )
THEN 23429 c( i, j ) = beta*c( i, j )
23444 IF( beta.EQ.zero )
THEN 23448 ELSE IF( beta.NE.one )
THEN 23450 c( i, j ) = beta*c( i, j )
23454 IF( b( l, j ).NE.zero )
THEN 23455 temp = alpha*b( l, j )
23457 c( i, j ) = c( i, j ) + temp*a( i, l )
23462 ELSE IF( conja )
THEN 23470 temp = temp + dconjg( a( l, i ) )*b( l, j )
23472 IF( beta.EQ.zero )
THEN 23473 c( i, j ) = alpha*temp
23475 c( i, j ) = alpha*temp + beta*c( i, j )
23487 temp = temp + a( l, i )*b( l, j )
23489 IF( beta.EQ.zero )
THEN 23490 c( i, j ) = alpha*temp
23492 c( i, j ) = alpha*temp + beta*c( i, j )
23497 ELSE IF( nota )
THEN 23503 IF( beta.EQ.zero )
THEN 23507 ELSE IF( beta.NE.one )
THEN 23509 c( i, j ) = beta*c( i, j )
23513 IF( b( j, l ).NE.zero )
THEN 23514 temp = alpha*dconjg( b( j, l ) )
23516 c( i, j ) = c( i, j ) + temp*a( i, l )
23526 IF( beta.EQ.zero )
THEN 23530 ELSE IF( beta.NE.one )
THEN 23532 c( i, j ) = beta*c( i, j )
23536 IF( b( j, l ).NE.zero )
THEN 23537 temp = alpha*b( j, l )
23539 c( i, j ) = c( i, j ) + temp*a( i, l )
23545 ELSE IF( conja )
THEN 23555 $ dconjg( a( l, i ) )*dconjg( b( j, l ) )
23557 IF( beta.EQ.zero )
THEN 23558 c( i, j ) = alpha*temp
23560 c( i, j ) = alpha*temp + beta*c( i, j )
23572 temp = temp + dconjg( a( l, i ) )*b( j, l )
23574 IF( beta.EQ.zero )
THEN 23575 c( i, j ) = alpha*temp
23577 c( i, j ) = alpha*temp + beta*c( i, j )
23591 temp = temp + a( l, i )*dconjg( b( j, l ) )
23593 IF( beta.EQ.zero )
THEN 23594 c( i, j ) = alpha*temp
23596 c( i, j ) = alpha*temp + beta*c( i, j )
23608 temp = temp + a( l, i )*b( j, l )
23610 IF( beta.EQ.zero )
THEN 23611 c( i, j ) = alpha*temp
23613 c( i, j ) = alpha*temp + beta*c( i, j )
23625 SUBROUTINE zgemv ( TRANS, M, N, ALPHA, A, LDA, X, INCX,
23628 COMPLEX*16 ALPHA, BETA
23629 INTEGER INCX, INCY, LDA, M, N
23632 COMPLEX*16 A( lda, * ), X( * ), Y( * )
23730 parameter( one = ( 1.0d+0, 0.0d+0 ) )
23732 parameter( zero = ( 0.0d+0, 0.0d+0 ) )
23735 INTEGER I, INFO, IX, IY, J, JX, JY, KX, KY, LENX, LENY
23743 INTRINSIC dconjg, max
23750 IF ( .NOT.lsame( trans,
'N' ).AND.
23751 $ .NOT.lsame( trans,
'T' ).AND.
23752 $ .NOT.lsame( trans,
'C' ) )
THEN 23754 ELSE IF( m.LT.0 )
THEN 23756 ELSE IF( n.LT.0 )
THEN 23758 ELSE IF( lda.LT.max( 1, m ) )
THEN 23760 ELSE IF( incx.EQ.0 )
THEN 23762 ELSE IF( incy.EQ.0 )
THEN 23765 IF( info.NE.0 )
THEN 23766 CALL xerbla(
'ZGEMV ', info )
23772 IF( ( m.EQ.0 ).OR.( n.EQ.0 ).OR.
23773 $ ( ( alpha.EQ.zero ).AND.( beta.EQ.one ) ) )
23776 noconj = lsame( trans,
'T' )
23781 IF( lsame( trans,
'N' ) )
THEN 23788 IF( incx.GT.0 )
THEN 23791 kx = 1 - ( lenx - 1 )*incx
23793 IF( incy.GT.0 )
THEN 23796 ky = 1 - ( leny - 1 )*incy
23804 IF( beta.NE.one )
THEN 23805 IF( incy.EQ.1 )
THEN 23806 IF( beta.EQ.zero )
THEN 23812 y( i ) = beta*y( i )
23817 IF( beta.EQ.zero )
THEN 23824 y( iy ) = beta*y( iy )
23830 IF( alpha.EQ.zero )
23832 IF( lsame( trans,
'N' ) )
THEN 23837 IF( incy.EQ.1 )
THEN 23839 IF( x( jx ).NE.zero )
THEN 23840 temp = alpha*x( jx )
23842 y( i ) = y( i ) + temp*a( i, j )
23849 IF( x( jx ).NE.zero )
THEN 23850 temp = alpha*x( jx )
23853 y( iy ) = y( iy ) + temp*a( i, j )
23865 IF( incx.EQ.1 )
THEN 23870 temp = temp + a( i, j )*x( i )
23874 temp = temp + dconjg( a( i, j ) )*x( i )
23877 y( jy ) = y( jy ) + alpha*temp
23886 temp = temp + a( i, j )*x( ix )
23891 temp = temp + dconjg( a( i, j ) )*x( ix )
23895 y( jy ) = y( jy ) + alpha*temp
23906 SUBROUTINE zgerc ( M, N, ALPHA, X, INCX, Y, INCY, A, LDA )
23909 INTEGER INCX, INCY, LDA, M, N
23911 COMPLEX*16 A( lda, * ), X( * ), Y( * )
23986 parameter( zero = ( 0.0d+0, 0.0d+0 ) )
23989 INTEGER I, INFO, IX, J, JY, KX
23993 INTRINSIC dconjg, max
24002 ELSE IF( n.LT.0 )
THEN 24004 ELSE IF( incx.EQ.0 )
THEN 24006 ELSE IF( incy.EQ.0 )
THEN 24008 ELSE IF( lda.LT.max( 1, m ) )
THEN 24011 IF( info.NE.0 )
THEN 24012 CALL xerbla(
'ZGERC ', info )
24018 IF( ( m.EQ.0 ).OR.( n.EQ.0 ).OR.( alpha.EQ.zero ) )
24024 IF( incy.GT.0 )
THEN 24027 jy = 1 - ( n - 1 )*incy
24029 IF( incx.EQ.1 )
THEN 24031 IF( y( jy ).NE.zero )
THEN 24032 temp = alpha*dconjg( y( jy ) )
24034 a( i, j ) = a( i, j ) + x( i )*temp
24040 IF( incx.GT.0 )
THEN 24043 kx = 1 - ( m - 1 )*incx
24046 IF( y( jy ).NE.zero )
THEN 24047 temp = alpha*dconjg( y( jy ) )
24050 a( i, j ) = a( i, j ) + x( ix )*temp
24063 SUBROUTINE zgeru ( M, N, ALPHA, X, INCX, Y, INCY, A, LDA )
24066 INTEGER INCX, INCY, LDA, M, N
24068 COMPLEX*16 A( lda, * ), X( * ), Y( * )
24143 parameter( zero = ( 0.0d+0, 0.0d+0 ) )
24146 INTEGER I, INFO, IX, J, JY, KX
24159 ELSE IF( n.LT.0 )
THEN 24161 ELSE IF( incx.EQ.0 )
THEN 24163 ELSE IF( incy.EQ.0 )
THEN 24165 ELSE IF( lda.LT.max( 1, m ) )
THEN 24168 IF( info.NE.0 )
THEN 24169 CALL xerbla(
'ZGERU ', info )
24175 IF( ( m.EQ.0 ).OR.( n.EQ.0 ).OR.( alpha.EQ.zero ) )
24181 IF( incy.GT.0 )
THEN 24184 jy = 1 - ( n - 1 )*incy
24186 IF( incx.EQ.1 )
THEN 24188 IF( y( jy ).NE.zero )
THEN 24189 temp = alpha*y( jy )
24191 a( i, j ) = a( i, j ) + x( i )*temp
24197 IF( incx.GT.0 )
THEN 24200 kx = 1 - ( m - 1 )*incx
24203 IF( y( jy ).NE.zero )
THEN 24204 temp = alpha*y( jy )
24207 a( i, j ) = a( i, j ) + x( ix )*temp
24220 SUBROUTINE zhbmv ( UPLO, N, K, ALPHA, A, LDA, X, INCX,
24223 COMPLEX*16 ALPHA, BETA
24224 INTEGER INCX, INCY, K, LDA, N
24227 COMPLEX*16 A( lda, * ), X( * ), Y( * )
24354 parameter( one = ( 1.0d+0, 0.0d+0 ) )
24356 parameter( zero = ( 0.0d+0, 0.0d+0 ) )
24358 COMPLEX*16 TEMP1, TEMP2
24359 INTEGER I, INFO, IX, IY, J, JX, JY, KPLUS1, KX, KY, L
24366 INTRINSIC dconjg, max, min, dble
24373 IF ( .NOT.lsame( uplo,
'U' ).AND.
24374 $ .NOT.lsame( uplo,
'L' ) )
THEN 24376 ELSE IF( n.LT.0 )
THEN 24378 ELSE IF( k.LT.0 )
THEN 24380 ELSE IF( lda.LT.( k + 1 ) )
THEN 24382 ELSE IF( incx.EQ.0 )
THEN 24384 ELSE IF( incy.EQ.0 )
THEN 24387 IF( info.NE.0 )
THEN 24388 CALL xerbla(
'ZHBMV ', info )
24394 IF( ( n.EQ.0 ).OR.( ( alpha.EQ.zero ).AND.( beta.EQ.one ) ) )
24399 IF( incx.GT.0 )
THEN 24402 kx = 1 - ( n - 1 )*incx
24404 IF( incy.GT.0 )
THEN 24407 ky = 1 - ( n - 1 )*incy
24415 IF( beta.NE.one )
THEN 24416 IF( incy.EQ.1 )
THEN 24417 IF( beta.EQ.zero )
THEN 24423 y( i ) = beta*y( i )
24428 IF( beta.EQ.zero )
THEN 24435 y( iy ) = beta*y( iy )
24441 IF( alpha.EQ.zero )
24443 IF( lsame( uplo,
'U' ) )
THEN 24448 IF( ( incx.EQ.1 ).AND.( incy.EQ.1 ) )
THEN 24450 temp1 = alpha*x( j )
24453 DO 50, i = max( 1, j - k ), j - 1
24454 y( i ) = y( i ) + temp1*a( l + i, j )
24455 temp2 = temp2 + dconjg( a( l + i, j ) )*x( i )
24457 y( j ) = y( j ) + temp1*dble( a( kplus1, j ) )
24464 temp1 = alpha*x( jx )
24469 DO 70, i = max( 1, j - k ), j - 1
24470 y( iy ) = y( iy ) + temp1*a( l + i, j )
24471 temp2 = temp2 + dconjg( a( l + i, j ) )*x( ix )
24475 y( jy ) = y( jy ) + temp1*dble( a( kplus1, j ) )
24489 IF( ( incx.EQ.1 ).AND.( incy.EQ.1 ) )
THEN 24491 temp1 = alpha*x( j )
24493 y( j ) = y( j ) + temp1*dble( a( 1, j ) )
24495 DO 90, i = j + 1, min( n, j + k )
24496 y( i ) = y( i ) + temp1*a( l + i, j )
24497 temp2 = temp2 + dconjg( a( l + i, j ) )*x( i )
24499 y( j ) = y( j ) + alpha*temp2
24505 temp1 = alpha*x( jx )
24507 y( jy ) = y( jy ) + temp1*dble( a( 1, j ) )
24511 DO 110, i = j + 1, min( n, j + k )
24514 y( iy ) = y( iy ) + temp1*a( l + i, j )
24515 temp2 = temp2 + dconjg( a( l + i, j ) )*x( ix )
24517 y( jy ) = y( jy ) + alpha*temp2
24529 SUBROUTINE zhemm ( SIDE, UPLO, M, N, ALPHA, A, LDA, B, LDB,
24532 CHARACTER*1 SIDE, UPLO
24533 INTEGER M, N, LDA, LDB, LDC
24534 COMPLEX*16 ALPHA, BETA
24536 COMPLEX*16 A( lda, * ), B( ldb, * ), C( ldc, * )
24671 INTRINSIC dconjg, max, dble
24674 INTEGER I, INFO, J, K, NROWA
24675 COMPLEX*16 TEMP1, TEMP2
24678 parameter( one = ( 1.0d+0, 0.0d+0 ) )
24680 parameter( zero = ( 0.0d+0, 0.0d+0 ) )
24686 IF( lsame( side,
'L' ) )
THEN 24691 upper = lsame( uplo,
'U' )
24696 IF( ( .NOT.lsame( side,
'L' ) ).AND.
24697 $ ( .NOT.lsame( side,
'R' ) ) )
THEN 24699 ELSE IF( ( .NOT.upper ).AND.
24700 $ ( .NOT.lsame( uplo,
'L' ) ) )
THEN 24702 ELSE IF( m .LT.0 )
THEN 24704 ELSE IF( n .LT.0 )
THEN 24706 ELSE IF( lda.LT.max( 1, nrowa ) )
THEN 24708 ELSE IF( ldb.LT.max( 1, m ) )
THEN 24710 ELSE IF( ldc.LT.max( 1, m ) )
THEN 24713 IF( info.NE.0 )
THEN 24714 CALL xerbla(
'ZHEMM ', info )
24720 IF( ( m.EQ.0 ).OR.( n.EQ.0 ).OR.
24721 $ ( ( alpha.EQ.zero ).AND.( beta.EQ.one ) ) )
24726 IF( alpha.EQ.zero )
THEN 24727 IF( beta.EQ.zero )
THEN 24736 c( i, j ) = beta*c( i, j )
24745 IF( lsame( side,
'L' ) )
THEN 24752 temp1 = alpha*b( i, j )
24754 DO 50, k = 1, i - 1
24755 c( k, j ) = c( k, j ) + temp1*a( k, i )
24757 $ b( k, j )*dconjg( a( k, i ) )
24759 IF( beta.EQ.zero )
THEN 24760 c( i, j ) = temp1*dble( a( i, i ) ) +
24763 c( i, j ) = beta *c( i, j ) +
24764 $ temp1*dble( a( i, i ) ) +
24771 DO 90, i = m, 1, -1
24772 temp1 = alpha*b( i, j )
24774 DO 80, k = i + 1, m
24775 c( k, j ) = c( k, j ) + temp1*a( k, i )
24777 $ b( k, j )*dconjg( a( k, i ) )
24779 IF( beta.EQ.zero )
THEN 24780 c( i, j ) = temp1*dble( a( i, i ) ) +
24783 c( i, j ) = beta *c( i, j ) +
24784 $ temp1*dble( a( i, i ) ) +
24795 temp1 = alpha*dble( a( j, j ) )
24796 IF( beta.EQ.zero )
THEN 24798 c( i, j ) = temp1*b( i, j )
24802 c( i, j ) = beta*c( i, j ) + temp1*b( i, j )
24805 DO 140, k = 1, j - 1
24807 temp1 = alpha*a( k, j )
24809 temp1 = alpha*dconjg( a( j, k ) )
24812 c( i, j ) = c( i, j ) + temp1*b( i, k )
24815 DO 160, k = j + 1, n
24817 temp1 = alpha*dconjg( a( j, k ) )
24819 temp1 = alpha*a( k, j )
24822 c( i, j ) = c( i, j ) + temp1*b( i, k )
24833 SUBROUTINE zhemv ( UPLO, N, ALPHA, A, LDA, X, INCX,
24836 COMPLEX*16 ALPHA, BETA
24837 INTEGER INCX, INCY, LDA, N
24840 COMPLEX*16 A( lda, * ), X( * ), Y( * )
24936 parameter( one = ( 1.0d+0, 0.0d+0 ) )
24938 parameter( zero = ( 0.0d+0, 0.0d+0 ) )
24940 COMPLEX*16 TEMP1, TEMP2
24941 INTEGER I, INFO, IX, IY, J, JX, JY, KX, KY
24948 INTRINSIC dconjg, max, dble
24955 IF ( .NOT.lsame( uplo,
'U' ).AND.
24956 $ .NOT.lsame( uplo,
'L' ) )
THEN 24958 ELSE IF( n.LT.0 )
THEN 24960 ELSE IF( lda.LT.max( 1, n ) )
THEN 24962 ELSE IF( incx.EQ.0 )
THEN 24964 ELSE IF( incy.EQ.0 )
THEN 24967 IF( info.NE.0 )
THEN 24968 CALL xerbla(
'ZHEMV ', info )
24974 IF( ( n.EQ.0 ).OR.( ( alpha.EQ.zero ).AND.( beta.EQ.one ) ) )
24979 IF( incx.GT.0 )
THEN 24982 kx = 1 - ( n - 1 )*incx
24984 IF( incy.GT.0 )
THEN 24987 ky = 1 - ( n - 1 )*incy
24996 IF( beta.NE.one )
THEN 24997 IF( incy.EQ.1 )
THEN 24998 IF( beta.EQ.zero )
THEN 25004 y( i ) = beta*y( i )
25009 IF( beta.EQ.zero )
THEN 25016 y( iy ) = beta*y( iy )
25022 IF( alpha.EQ.zero )
25024 IF( lsame( uplo,
'U' ) )
THEN 25028 IF( ( incx.EQ.1 ).AND.( incy.EQ.1 ) )
THEN 25030 temp1 = alpha*x( j )
25032 DO 50, i = 1, j - 1
25033 y( i ) = y( i ) + temp1*a( i, j )
25034 temp2 = temp2 + dconjg( a( i, j ) )*x( i )
25036 y( j ) = y( j ) + temp1*dble( a( j, j ) ) + alpha*temp2
25042 temp1 = alpha*x( jx )
25046 DO 70, i = 1, j - 1
25047 y( iy ) = y( iy ) + temp1*a( i, j )
25048 temp2 = temp2 + dconjg( a( i, j ) )*x( ix )
25052 y( jy ) = y( jy ) + temp1*dble( a( j, j ) ) + alpha*temp2
25061 IF( ( incx.EQ.1 ).AND.( incy.EQ.1 ) )
THEN 25063 temp1 = alpha*x( j )
25065 y( j ) = y( j ) + temp1*dble( a( j, j ) )
25066 DO 90, i = j + 1, n
25067 y( i ) = y( i ) + temp1*a( i, j )
25068 temp2 = temp2 + dconjg( a( i, j ) )*x( i )
25070 y( j ) = y( j ) + alpha*temp2
25076 temp1 = alpha*x( jx )
25078 y( jy ) = y( jy ) + temp1*dble( a( j, j ) )
25081 DO 110, i = j + 1, n
25084 y( iy ) = y( iy ) + temp1*a( i, j )
25085 temp2 = temp2 + dconjg( a( i, j ) )*x( ix )
25087 y( jy ) = y( jy ) + alpha*temp2
25099 SUBROUTINE zher2 ( UPLO, N, ALPHA, X, INCX, Y, INCY, A, LDA )
25102 INTEGER INCX, INCY, LDA, N
25105 COMPLEX*16 A( lda, * ), X( * ), Y( * )
25200 parameter( zero = ( 0.0d+0, 0.0d+0 ) )
25202 COMPLEX*16 TEMP1, TEMP2
25203 INTEGER I, INFO, IX, IY, J, JX, JY, KX, KY
25210 INTRINSIC dconjg, max, dble
25217 IF ( .NOT.lsame( uplo,
'U' ).AND.
25218 $ .NOT.lsame( uplo,
'L' ) )
THEN 25220 ELSE IF( n.LT.0 )
THEN 25222 ELSE IF( incx.EQ.0 )
THEN 25224 ELSE IF( incy.EQ.0 )
THEN 25226 ELSE IF( lda.LT.max( 1, n ) )
THEN 25229 IF( info.NE.0 )
THEN 25230 CALL xerbla(
'ZHER2 ', info )
25236 IF( ( n.EQ.0 ).OR.( alpha.EQ.zero ) )
25242 IF( ( incx.NE.1 ).OR.( incy.NE.1 ) )
THEN 25243 IF( incx.GT.0 )
THEN 25246 kx = 1 - ( n - 1 )*incx
25248 IF( incy.GT.0 )
THEN 25251 ky = 1 - ( n - 1 )*incy
25261 IF( lsame( uplo,
'U' ) )
THEN 25265 IF( ( incx.EQ.1 ).AND.( incy.EQ.1 ) )
THEN 25267 IF( ( x( j ).NE.zero ).OR.( y( j ).NE.zero ) )
THEN 25268 temp1 = alpha*dconjg( y( j ) )
25269 temp2 = dconjg( alpha*x( j ) )
25270 DO 10, i = 1, j - 1
25271 a( i, j ) = a( i, j ) + x( i )*temp1 + y( i )*temp2
25273 a( j, j ) = dble( a( j, j ) ) +
25274 $ dble( x( j )*temp1 + y( j )*temp2 )
25276 a( j, j ) = dble( a( j, j ) )
25281 IF( ( x( jx ).NE.zero ).OR.( y( jy ).NE.zero ) )
THEN 25282 temp1 = alpha*dconjg( y( jy ) )
25283 temp2 = dconjg( alpha*x( jx ) )
25286 DO 30, i = 1, j - 1
25287 a( i, j ) = a( i, j ) + x( ix )*temp1
25292 a( j, j ) = dble( a( j, j ) ) +
25293 $ dble( x( jx )*temp1 + y( jy )*temp2 )
25295 a( j, j ) = dble( a( j, j ) )
25305 IF( ( incx.EQ.1 ).AND.( incy.EQ.1 ) )
THEN 25307 IF( ( x( j ).NE.zero ).OR.( y( j ).NE.zero ) )
THEN 25308 temp1 = alpha*dconjg( y( j ) )
25309 temp2 = dconjg( alpha*x( j ) )
25310 a( j, j ) = dble( a( j, j ) ) +
25311 $ dble( x( j )*temp1 + y( j )*temp2 )
25312 DO 50, i = j + 1, n
25313 a( i, j ) = a( i, j ) + x( i )*temp1 + y( i )*temp2
25316 a( j, j ) = dble( a( j, j ) )
25321 IF( ( x( jx ).NE.zero ).OR.( y( jy ).NE.zero ) )
THEN 25322 temp1 = alpha*dconjg( y( jy ) )
25323 temp2 = dconjg( alpha*x( jx ) )
25324 a( j, j ) = dble( a( j, j ) ) +
25325 $ dble( x( jx )*temp1 + y( jy )*temp2 )
25328 DO 70, i = j + 1, n
25331 a( i, j ) = a( i, j ) + x( ix )*temp1
25335 a( j, j ) = dble( a( j, j ) )
25348 SUBROUTINE zher2k( UPLO, TRANS, N, K, ALPHA, A, LDA, B, LDB, BETA,
25351 CHARACTER TRANS, UPLO
25352 INTEGER K, LDA, LDB, LDC, N
25353 DOUBLE PRECISION BETA
25357 COMPLEX*16 A( lda, * ), B( ldb, * ), C( ldc, * )
25499 INTRINSIC dble, dconjg, max
25503 INTEGER I, INFO, J, L, NROWA
25504 COMPLEX*16 TEMP1, TEMP2
25507 DOUBLE PRECISION ONE
25508 parameter( one = 1.0d+0 )
25510 parameter( zero = ( 0.0d+0, 0.0d+0 ) )
25516 IF( lsame( trans,
'N' ) )
THEN 25521 upper = lsame( uplo,
'U' )
25524 IF( ( .NOT.upper ) .AND. ( .NOT.lsame( uplo,
'L' ) ) )
THEN 25526 ELSE IF( ( .NOT.lsame( trans,
'N' ) ) .AND.
25527 $ ( .NOT.lsame( trans,
'C' ) ) )
THEN 25529 ELSE IF( n.LT.0 )
THEN 25531 ELSE IF( k.LT.0 )
THEN 25533 ELSE IF( lda.LT.max( 1, nrowa ) )
THEN 25535 ELSE IF( ldb.LT.max( 1, nrowa ) )
THEN 25537 ELSE IF( ldc.LT.max( 1, n ) )
THEN 25540 IF( info.NE.0 )
THEN 25541 CALL xerbla(
'ZHER2K', info )
25547 IF( ( n.EQ.0 ) .OR. ( ( ( alpha.EQ.zero ) .OR. ( k.EQ.0 ) ) .AND.
25548 $ ( beta.EQ.one ) ) )
RETURN 25552 IF( alpha.EQ.zero )
THEN 25554 IF( beta.EQ.dble( zero ) )
THEN 25563 c( i, j ) = beta*c( i, j )
25565 c( j, j ) = beta*dble( c( j, j ) )
25569 IF( beta.EQ.dble( zero ) )
THEN 25577 c( j, j ) = beta*dble( c( j, j ) )
25579 c( i, j ) = beta*c( i, j )
25589 IF( lsame( trans,
'N' ) )
THEN 25596 IF( beta.EQ.dble( zero ) )
THEN 25600 ELSE IF( beta.NE.one )
THEN 25601 DO 100 i = 1, j - 1
25602 c( i, j ) = beta*c( i, j )
25604 c( j, j ) = beta*dble( c( j, j ) )
25606 c( j, j ) = dble( c( j, j ) )
25609 IF( ( a( j, l ).NE.zero ) .OR. ( b( j, l ).NE.zero ) )
25611 temp1 = alpha*dconjg( b( j, l ) )
25612 temp2 = dconjg( alpha*a( j, l ) )
25613 DO 110 i = 1, j - 1
25614 c( i, j ) = c( i, j ) + a( i, l )*temp1 +
25617 c( j, j ) = dble( c( j, j ) ) +
25618 $ dble( a( j, l )*temp1+b( j, l )*temp2 )
25624 IF( beta.EQ.dble( zero ) )
THEN 25628 ELSE IF( beta.NE.one )
THEN 25629 DO 150 i = j + 1, n
25630 c( i, j ) = beta*c( i, j )
25632 c( j, j ) = beta*dble( c( j, j ) )
25634 c( j, j ) = dble( c( j, j ) )
25637 IF( ( a( j, l ).NE.zero ) .OR. ( b( j, l ).NE.zero ) )
25639 temp1 = alpha*dconjg( b( j, l ) )
25640 temp2 = dconjg( alpha*a( j, l ) )
25641 DO 160 i = j + 1, n
25642 c( i, j ) = c( i, j ) + a( i, l )*temp1 +
25645 c( j, j ) = dble( c( j, j ) ) +
25646 $ dble( a( j, l )*temp1+b( j, l )*temp2 )
25662 temp1 = temp1 + dconjg( a( l, i ) )*b( l, j )
25663 temp2 = temp2 + dconjg( b( l, i ) )*a( l, j )
25666 IF( beta.EQ.dble( zero ) )
THEN 25667 c( j, j ) = dble( alpha*temp1+dconjg( alpha )*
25670 c( j, j ) = beta*dble( c( j, j ) ) +
25671 $ dble( alpha*temp1+dconjg( alpha )*
25675 IF( beta.EQ.dble( zero ) )
THEN 25676 c( i, j ) = alpha*temp1 + dconjg( alpha )*temp2
25678 c( i, j ) = beta*c( i, j ) + alpha*temp1 +
25679 $ dconjg( alpha )*temp2
25690 temp1 = temp1 + dconjg( a( l, i ) )*b( l, j )
25691 temp2 = temp2 + dconjg( b( l, i ) )*a( l, j )
25694 IF( beta.EQ.dble( zero ) )
THEN 25695 c( j, j ) = dble( alpha*temp1+dconjg( alpha )*
25698 c( j, j ) = beta*dble( c( j, j ) ) +
25699 $ dble( alpha*temp1+dconjg( alpha )*
25703 IF( beta.EQ.dble( zero ) )
THEN 25704 c( i, j ) = alpha*temp1 + dconjg( alpha )*temp2
25706 c( i, j ) = beta*c( i, j ) + alpha*temp1 +
25707 $ dconjg( alpha )*temp2
25720 SUBROUTINE zher ( UPLO, N, ALPHA, X, INCX, A, LDA )
25722 DOUBLE PRECISION ALPHA
25723 INTEGER INCX, LDA, N
25726 COMPLEX*16 A( lda, * ), X( * )
25810 parameter( zero = ( 0.0d+0, 0.0d+0 ) )
25813 INTEGER I, INFO, IX, J, JX, KX
25820 INTRINSIC dconjg, max, dble
25827 IF ( .NOT.lsame( uplo,
'U' ).AND.
25828 $ .NOT.lsame( uplo,
'L' ) )
THEN 25830 ELSE IF( n.LT.0 )
THEN 25832 ELSE IF( incx.EQ.0 )
THEN 25834 ELSE IF( lda.LT.max( 1, n ) )
THEN 25837 IF( info.NE.0 )
THEN 25838 CALL xerbla(
'ZHER ', info )
25844 IF( ( n.EQ.0 ).OR.( alpha.EQ.dble( zero ) ) )
25849 IF( incx.LE.0 )
THEN 25850 kx = 1 - ( n - 1 )*incx
25851 ELSE IF( incx.NE.1 )
THEN 25859 IF( lsame( uplo,
'U' ) )
THEN 25863 IF( incx.EQ.1 )
THEN 25865 IF( x( j ).NE.zero )
THEN 25866 temp = alpha*dconjg( x( j ) )
25867 DO 10, i = 1, j - 1
25868 a( i, j ) = a( i, j ) + x( i )*temp
25870 a( j, j ) = dble( a( j, j ) ) + dble( x( j )*temp )
25872 a( j, j ) = dble( a( j, j ) )
25878 IF( x( jx ).NE.zero )
THEN 25879 temp = alpha*dconjg( x( jx ) )
25881 DO 30, i = 1, j - 1
25882 a( i, j ) = a( i, j ) + x( ix )*temp
25885 a( j, j ) = dble( a( j, j ) ) + dble( x( jx )*temp )
25887 a( j, j ) = dble( a( j, j ) )
25896 IF( incx.EQ.1 )
THEN 25898 IF( x( j ).NE.zero )
THEN 25899 temp = alpha*dconjg( x( j ) )
25900 a( j, j ) = dble( a( j, j ) ) + dble( temp*x( j ) )
25901 DO 50, i = j + 1, n
25902 a( i, j ) = a( i, j ) + x( i )*temp
25905 a( j, j ) = dble( a( j, j ) )
25911 IF( x( jx ).NE.zero )
THEN 25912 temp = alpha*dconjg( x( jx ) )
25913 a( j, j ) = dble( a( j, j ) ) + dble( temp*x( jx ) )
25915 DO 70, i = j + 1, n
25917 a( i, j ) = a( i, j ) + x( ix )*temp
25920 a( j, j ) = dble( a( j, j ) )
25932 SUBROUTINE zherk( UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, C, LDC )
25934 CHARACTER TRANS, UPLO
25935 INTEGER K, LDA, LDC, N
25936 DOUBLE PRECISION ALPHA, BETA
25939 COMPLEX*16 A( lda, * ), C( ldc, * )
26062 INTRINSIC dble, dcmplx, dconjg, max
26066 INTEGER I, INFO, J, L, NROWA
26067 DOUBLE PRECISION RTEMP
26071 DOUBLE PRECISION ONE, ZERO
26072 parameter( one = 1.0d+0, zero = 0.0d+0 )
26078 IF( lsame( trans,
'N' ) )
THEN 26083 upper = lsame( uplo,
'U' )
26086 IF( ( .NOT.upper ) .AND. ( .NOT.lsame( uplo,
'L' ) ) )
THEN 26088 ELSE IF( ( .NOT.lsame( trans,
'N' ) ) .AND.
26089 $ ( .NOT.lsame( trans,
'C' ) ) )
THEN 26091 ELSE IF( n.LT.0 )
THEN 26093 ELSE IF( k.LT.0 )
THEN 26095 ELSE IF( lda.LT.max( 1, nrowa ) )
THEN 26097 ELSE IF( ldc.LT.max( 1, n ) )
THEN 26100 IF( info.NE.0 )
THEN 26101 CALL xerbla(
'ZHERK ', info )
26107 IF( ( n.EQ.0 ) .OR. ( ( ( alpha.EQ.zero ) .OR. ( k.EQ.0 ) ) .AND.
26108 $ ( beta.EQ.one ) ) )
RETURN 26112 IF( alpha.EQ.zero )
THEN 26114 IF( beta.EQ.zero )
THEN 26123 c( i, j ) = beta*c( i, j )
26125 c( j, j ) = beta*dble( c( j, j ) )
26129 IF( beta.EQ.zero )
THEN 26137 c( j, j ) = beta*dble( c( j, j ) )
26139 c( i, j ) = beta*c( i, j )
26149 IF( lsame( trans,
'N' ) )
THEN 26155 IF( beta.EQ.zero )
THEN 26159 ELSE IF( beta.NE.one )
THEN 26160 DO 100 i = 1, j - 1
26161 c( i, j ) = beta*c( i, j )
26163 c( j, j ) = beta*dble( c( j, j ) )
26165 c( j, j ) = dble( c( j, j ) )
26168 IF( a( j, l ).NE.dcmplx( zero ) )
THEN 26169 temp = alpha*dconjg( a( j, l ) )
26170 DO 110 i = 1, j - 1
26171 c( i, j ) = c( i, j ) + temp*a( i, l )
26173 c( j, j ) = dble( c( j, j ) ) +
26174 $ dble( temp*a( i, l ) )
26180 IF( beta.EQ.zero )
THEN 26184 ELSE IF( beta.NE.one )
THEN 26185 c( j, j ) = beta*dble( c( j, j ) )
26186 DO 150 i = j + 1, n
26187 c( i, j ) = beta*c( i, j )
26190 c( j, j ) = dble( c( j, j ) )
26193 IF( a( j, l ).NE.dcmplx( zero ) )
THEN 26194 temp = alpha*dconjg( a( j, l ) )
26195 c( j, j ) = dble( c( j, j ) ) +
26196 $ dble( temp*a( j, l ) )
26197 DO 160 i = j + 1, n
26198 c( i, j ) = c( i, j ) + temp*a( i, l )
26210 DO 200 i = 1, j - 1
26213 temp = temp + dconjg( a( l, i ) )*a( l, j )
26215 IF( beta.EQ.zero )
THEN 26216 c( i, j ) = alpha*temp
26218 c( i, j ) = alpha*temp + beta*c( i, j )
26223 rtemp = rtemp + dconjg( a( l, j ) )*a( l, j )
26225 IF( beta.EQ.zero )
THEN 26226 c( j, j ) = alpha*rtemp
26228 c( j, j ) = alpha*rtemp + beta*dble( c( j, j ) )
26235 rtemp = rtemp + dconjg( a( l, j ) )*a( l, j )
26237 IF( beta.EQ.zero )
THEN 26238 c( j, j ) = alpha*rtemp
26240 c( j, j ) = alpha*rtemp + beta*dble( c( j, j ) )
26242 DO 250 i = j + 1, n
26245 temp = temp + dconjg( a( l, i ) )*a( l, j )
26247 IF( beta.EQ.zero )
THEN 26248 c( i, j ) = alpha*temp
26250 c( i, j ) = alpha*temp + beta*c( i, j )
26262 SUBROUTINE zhpmv ( UPLO, N, ALPHA, AP, X, INCX, BETA, Y, INCY )
26264 COMPLEX*16 ALPHA, BETA
26265 INTEGER INCX, INCY, N
26268 COMPLEX*16 AP( * ), X( * ), Y( * )
26361 parameter( one = ( 1.0d+0, 0.0d+0 ) )
26363 parameter( zero = ( 0.0d+0, 0.0d+0 ) )
26365 COMPLEX*16 TEMP1, TEMP2
26366 INTEGER I, INFO, IX, IY, J, JX, JY, K, KK, KX, KY
26373 INTRINSIC dconjg, dble
26380 IF ( .NOT.lsame( uplo,
'U' ).AND.
26381 $ .NOT.lsame( uplo,
'L' ) )
THEN 26383 ELSE IF( n.LT.0 )
THEN 26385 ELSE IF( incx.EQ.0 )
THEN 26387 ELSE IF( incy.EQ.0 )
THEN 26390 IF( info.NE.0 )
THEN 26391 CALL xerbla(
'ZHPMV ', info )
26397 IF( ( n.EQ.0 ).OR.( ( alpha.EQ.zero ).AND.( beta.EQ.one ) ) )
26402 IF( incx.GT.0 )
THEN 26405 kx = 1 - ( n - 1 )*incx
26407 IF( incy.GT.0 )
THEN 26410 ky = 1 - ( n - 1 )*incy
26418 IF( beta.NE.one )
THEN 26419 IF( incy.EQ.1 )
THEN 26420 IF( beta.EQ.zero )
THEN 26426 y( i ) = beta*y( i )
26431 IF( beta.EQ.zero )
THEN 26438 y( iy ) = beta*y( iy )
26444 IF( alpha.EQ.zero )
26447 IF( lsame( uplo,
'U' ) )
THEN 26451 IF( ( incx.EQ.1 ).AND.( incy.EQ.1 ) )
THEN 26453 temp1 = alpha*x( j )
26456 DO 50, i = 1, j - 1
26457 y( i ) = y( i ) + temp1*ap( k )
26458 temp2 = temp2 + dconjg( ap( k ) )*x( i )
26461 y( j ) = y( j ) + temp1*dble( ap( kk + j - 1 ) )
26469 temp1 = alpha*x( jx )
26473 DO 70, k = kk, kk + j - 2
26474 y( iy ) = y( iy ) + temp1*ap( k )
26475 temp2 = temp2 + dconjg( ap( k ) )*x( ix )
26479 y( jy ) = y( jy ) + temp1*dble( ap( kk + j - 1 ) )
26490 IF( ( incx.EQ.1 ).AND.( incy.EQ.1 ) )
THEN 26492 temp1 = alpha*x( j )
26494 y( j ) = y( j ) + temp1*dble( ap( kk ) )
26496 DO 90, i = j + 1, n
26497 y( i ) = y( i ) + temp1*ap( k )
26498 temp2 = temp2 + dconjg( ap( k ) )*x( i )
26501 y( j ) = y( j ) + alpha*temp2
26502 kk = kk + ( n - j + 1 )
26508 temp1 = alpha*x( jx )
26510 y( jy ) = y( jy ) + temp1*dble( ap( kk ) )
26513 DO 110, k = kk + 1, kk + n - j
26516 y( iy ) = y( iy ) + temp1*ap( k )
26517 temp2 = temp2 + dconjg( ap( k ) )*x( ix )
26519 y( jy ) = y( jy ) + alpha*temp2
26522 kk = kk + ( n - j + 1 )
26532 SUBROUTINE zhpr2 ( UPLO, N, ALPHA, X, INCX, Y, INCY, AP )
26535 INTEGER INCX, INCY, N
26538 COMPLEX*16 AP( * ), X( * ), Y( * )
26630 parameter( zero = ( 0.0d+0, 0.0d+0 ) )
26632 COMPLEX*16 TEMP1, TEMP2
26633 INTEGER I, INFO, IX, IY, J, JX, JY, K, KK, KX, KY
26640 INTRINSIC dconjg, dble
26647 IF ( .NOT.lsame( uplo,
'U' ).AND.
26648 $ .NOT.lsame( uplo,
'L' ) )
THEN 26650 ELSE IF( n.LT.0 )
THEN 26652 ELSE IF( incx.EQ.0 )
THEN 26654 ELSE IF( incy.EQ.0 )
THEN 26657 IF( info.NE.0 )
THEN 26658 CALL xerbla(
'ZHPR2 ', info )
26664 IF( ( n.EQ.0 ).OR.( alpha.EQ.zero ) )
26670 IF( ( incx.NE.1 ).OR.( incy.NE.1 ) )
THEN 26671 IF( incx.GT.0 )
THEN 26674 kx = 1 - ( n - 1 )*incx
26676 IF( incy.GT.0 )
THEN 26679 ky = 1 - ( n - 1 )*incy
26689 IF( lsame( uplo,
'U' ) )
THEN 26693 IF( ( incx.EQ.1 ).AND.( incy.EQ.1 ) )
THEN 26695 IF( ( x( j ).NE.zero ).OR.( y( j ).NE.zero ) )
THEN 26696 temp1 = alpha*dconjg( y( j ) )
26697 temp2 = dconjg( alpha*x( j ) )
26699 DO 10, i = 1, j - 1
26700 ap( k ) = ap( k ) + x( i )*temp1 + y( i )*temp2
26703 ap( kk + j - 1 ) = dble( ap( kk + j - 1 ) ) +
26704 $ dble( x( j )*temp1 + y( j )*temp2 )
26706 ap( kk + j - 1 ) = dble( ap( kk + j - 1 ) )
26712 IF( ( x( jx ).NE.zero ).OR.( y( jy ).NE.zero ) )
THEN 26713 temp1 = alpha*dconjg( y( jy ) )
26714 temp2 = dconjg( alpha*x( jx ) )
26717 DO 30, k = kk, kk + j - 2
26718 ap( k ) = ap( k ) + x( ix )*temp1 + y( iy )*temp2
26722 ap( kk + j - 1 ) = dble( ap( kk + j - 1 ) ) +
26723 $ dble( x( jx )*temp1 +
26726 ap( kk + j - 1 ) = dble( ap( kk + j - 1 ) )
26737 IF( ( incx.EQ.1 ).AND.( incy.EQ.1 ) )
THEN 26739 IF( ( x( j ).NE.zero ).OR.( y( j ).NE.zero ) )
THEN 26740 temp1 = alpha*dconjg( y( j ) )
26741 temp2 = dconjg( alpha*x( j ) )
26742 ap( kk ) = dble( ap( kk ) ) +
26743 $ dble( x( j )*temp1 + y( j )*temp2 )
26745 DO 50, i = j + 1, n
26746 ap( k ) = ap( k ) + x( i )*temp1 + y( i )*temp2
26750 ap( kk ) = dble( ap( kk ) )
26752 kk = kk + n - j + 1
26756 IF( ( x( jx ).NE.zero ).OR.( y( jy ).NE.zero ) )
THEN 26757 temp1 = alpha*dconjg( y( jy ) )
26758 temp2 = dconjg( alpha*x( jx ) )
26759 ap( kk ) = dble( ap( kk ) ) +
26760 $ dble( x( jx )*temp1 + y( jy )*temp2 )
26763 DO 70, k = kk + 1, kk + n - j
26766 ap( k ) = ap( k ) + x( ix )*temp1 + y( iy )*temp2
26769 ap( kk ) = dble( ap( kk ) )
26773 kk = kk + n - j + 1
26783 SUBROUTINE zhpr ( UPLO, N, ALPHA, X, INCX, AP )
26785 DOUBLE PRECISION ALPHA
26789 COMPLEX*16 AP( * ), X( * )
26870 parameter( zero = ( 0.0d+0, 0.0d+0 ) )
26873 INTEGER I, INFO, IX, J, JX, K, KK, KX
26880 INTRINSIC dconjg, dble
26887 IF ( .NOT.lsame( uplo,
'U' ).AND.
26888 $ .NOT.lsame( uplo,
'L' ) )
THEN 26890 ELSE IF( n.LT.0 )
THEN 26892 ELSE IF( incx.EQ.0 )
THEN 26895 IF( info.NE.0 )
THEN 26896 CALL xerbla(
'ZHPR ', info )
26902 IF( ( n.EQ.0 ).OR.( alpha.EQ.dble( zero ) ) )
26907 IF( incx.LE.0 )
THEN 26908 kx = 1 - ( n - 1 )*incx
26909 ELSE IF( incx.NE.1 )
THEN 26917 IF( lsame( uplo,
'U' ) )
THEN 26921 IF( incx.EQ.1 )
THEN 26923 IF( x( j ).NE.zero )
THEN 26924 temp = alpha*dconjg( x( j ) )
26926 DO 10, i = 1, j - 1
26927 ap( k ) = ap( k ) + x( i )*temp
26930 ap( kk + j - 1 ) = dble( ap( kk + j - 1 ) )
26931 $ + dble( x( j )*temp )
26933 ap( kk + j - 1 ) = dble( ap( kk + j - 1 ) )
26940 IF( x( jx ).NE.zero )
THEN 26941 temp = alpha*dconjg( x( jx ) )
26943 DO 30, k = kk, kk + j - 2
26944 ap( k ) = ap( k ) + x( ix )*temp
26947 ap( kk + j - 1 ) = dble( ap( kk + j - 1 ) )
26948 $ + dble( x( jx )*temp )
26950 ap( kk + j - 1 ) = dble( ap( kk + j - 1 ) )
26960 IF( incx.EQ.1 )
THEN 26962 IF( x( j ).NE.zero )
THEN 26963 temp = alpha*dconjg( x( j ) )
26964 ap( kk ) = dble( ap( kk ) ) + dble( temp*x( j ) )
26966 DO 50, i = j + 1, n
26967 ap( k ) = ap( k ) + x( i )*temp
26971 ap( kk ) = dble( ap( kk ) )
26973 kk = kk + n - j + 1
26978 IF( x( jx ).NE.zero )
THEN 26979 temp = alpha*dconjg( x( jx ) )
26980 ap( kk ) = dble( ap( kk ) ) + dble( temp*x( jx ) )
26982 DO 70, k = kk + 1, kk + n - j
26984 ap( k ) = ap( k ) + x( ix )*temp
26987 ap( kk ) = dble( ap( kk ) )
26990 kk = kk + n - j + 1
27000 subroutine zrotg(ca,cb,c,s)
27001 double complex ca,cb,s
27003 double precision norm,scale
27004 double complex alpha
27005 if (cdabs(ca) .ne. 0.0d0)
go to 10
27011 scale = cdabs(ca) + cdabs(cb)
27012 norm = scale*dsqrt((cdabs(ca/dcmplx(scale,0.0d0)))**2 +
27013 * (cdabs(cb/dcmplx(scale,0.0d0)))**2)
27014 alpha = ca /cdabs(ca)
27015 c = cdabs(ca) / norm
27016 s = alpha * dconjg(cb) / norm
27021 subroutine zscal(n,za,zx,incx)
27028 double complex za,zx(*)
27029 integer i,incx,ix,n
27031 if( n.le.0 .or. incx.le.0 )
return 27032 if(incx.eq.1)
go to 20
27050 subroutine zswap (n,zx,incx,zy,incy)
27056 double complex zx(*),zy(*),ztemp
27057 integer i,incx,incy,ix,iy,n
27060 if(incx.eq.1.and.incy.eq.1)
go to 20
27067 if(incx.lt.0)ix = (-n+1)*incx + 1
27068 if(incy.lt.0)iy = (-n+1)*incy + 1
27086 SUBROUTINE zsymm ( SIDE, UPLO, M, N, ALPHA, A, LDA, B, LDB,
27089 CHARACTER*1 SIDE, UPLO
27090 INTEGER M, N, LDA, LDB, LDC
27091 COMPLEX*16 ALPHA, BETA
27093 COMPLEX*16 A( lda, * ), B( ldb, * ), C( ldc, * )
27229 INTEGER I, INFO, J, K, NROWA
27230 COMPLEX*16 TEMP1, TEMP2
27233 parameter( one = ( 1.0d+0, 0.0d+0 ) )
27235 parameter( zero = ( 0.0d+0, 0.0d+0 ) )
27241 IF( lsame( side,
'L' ) )
THEN 27246 upper = lsame( uplo,
'U' )
27251 IF( ( .NOT.lsame( side,
'L' ) ).AND.
27252 $ ( .NOT.lsame( side,
'R' ) ) )
THEN 27254 ELSE IF( ( .NOT.upper ).AND.
27255 $ ( .NOT.lsame( uplo,
'L' ) ) )
THEN 27257 ELSE IF( m .LT.0 )
THEN 27259 ELSE IF( n .LT.0 )
THEN 27261 ELSE IF( lda.LT.max( 1, nrowa ) )
THEN 27263 ELSE IF( ldb.LT.max( 1, m ) )
THEN 27265 ELSE IF( ldc.LT.max( 1, m ) )
THEN 27268 IF( info.NE.0 )
THEN 27269 CALL xerbla(
'ZSYMM ', info )
27275 IF( ( m.EQ.0 ).OR.( n.EQ.0 ).OR.
27276 $ ( ( alpha.EQ.zero ).AND.( beta.EQ.one ) ) )
27281 IF( alpha.EQ.zero )
THEN 27282 IF( beta.EQ.zero )
THEN 27291 c( i, j ) = beta*c( i, j )
27300 IF( lsame( side,
'L' ) )
THEN 27307 temp1 = alpha*b( i, j )
27309 DO 50, k = 1, i - 1
27310 c( k, j ) = c( k, j ) + temp1 *a( k, i )
27311 temp2 = temp2 + b( k, j )*a( k, i )
27313 IF( beta.EQ.zero )
THEN 27314 c( i, j ) = temp1*a( i, i ) + alpha*temp2
27316 c( i, j ) = beta *c( i, j ) +
27317 $ temp1*a( i, i ) + alpha*temp2
27323 DO 90, i = m, 1, -1
27324 temp1 = alpha*b( i, j )
27326 DO 80, k = i + 1, m
27327 c( k, j ) = c( k, j ) + temp1 *a( k, i )
27328 temp2 = temp2 + b( k, j )*a( k, i )
27330 IF( beta.EQ.zero )
THEN 27331 c( i, j ) = temp1*a( i, i ) + alpha*temp2
27333 c( i, j ) = beta *c( i, j ) +
27334 $ temp1*a( i, i ) + alpha*temp2
27344 temp1 = alpha*a( j, j )
27345 IF( beta.EQ.zero )
THEN 27347 c( i, j ) = temp1*b( i, j )
27351 c( i, j ) = beta*c( i, j ) + temp1*b( i, j )
27354 DO 140, k = 1, j - 1
27356 temp1 = alpha*a( k, j )
27358 temp1 = alpha*a( j, k )
27361 c( i, j ) = c( i, j ) + temp1*b( i, k )
27364 DO 160, k = j + 1, n
27366 temp1 = alpha*a( j, k )
27368 temp1 = alpha*a( k, j )
27371 c( i, j ) = c( i, j ) + temp1*b( i, k )
27382 SUBROUTINE zsyr2k( UPLO, TRANS, N, K, ALPHA, A, LDA, B, LDB,
27385 CHARACTER*1 UPLO, TRANS
27386 INTEGER N, K, LDA, LDB, LDC
27387 COMPLEX*16 ALPHA, BETA
27389 COMPLEX*16 A( lda, * ), B( ldb, * ), C( ldc, * )
27524 INTEGER I, INFO, J, L, NROWA
27525 COMPLEX*16 TEMP1, TEMP2
27528 parameter( one = ( 1.0d+0, 0.0d+0 ) )
27530 parameter( zero = ( 0.0d+0, 0.0d+0 ) )
27536 IF( lsame( trans,
'N' ) )
THEN 27541 upper = lsame( uplo,
'U' )
27544 IF( ( .NOT.upper ).AND.
27545 $ ( .NOT.lsame( uplo ,
'L' ) ) )
THEN 27547 ELSE IF( ( .NOT.lsame( trans,
'N' ) ).AND.
27548 $ ( .NOT.lsame( trans,
'T' ) ) )
THEN 27550 ELSE IF( n .LT.0 )
THEN 27552 ELSE IF( k .LT.0 )
THEN 27554 ELSE IF( lda.LT.max( 1, nrowa ) )
THEN 27556 ELSE IF( ldb.LT.max( 1, nrowa ) )
THEN 27558 ELSE IF( ldc.LT.max( 1, n ) )
THEN 27561 IF( info.NE.0 )
THEN 27562 CALL xerbla(
'ZSYR2K', info )
27569 $ ( ( ( alpha.EQ.zero ).OR.( k.EQ.0 ) ).AND.( beta.EQ.one ) ) )
27574 IF( alpha.EQ.zero )
THEN 27576 IF( beta.EQ.zero )
THEN 27585 c( i, j ) = beta*c( i, j )
27590 IF( beta.EQ.zero )
THEN 27599 c( i, j ) = beta*c( i, j )
27609 IF( lsame( trans,
'N' ) )
THEN 27615 IF( beta.EQ.zero )
THEN 27619 ELSE IF( beta.NE.one )
THEN 27621 c( i, j ) = beta*c( i, j )
27625 IF( ( a( j, l ).NE.zero ).OR.
27626 $ ( b( j, l ).NE.zero ) )
THEN 27627 temp1 = alpha*b( j, l )
27628 temp2 = alpha*a( j, l )
27630 c( i, j ) = c( i, j ) + a( i, l )*temp1 +
27638 IF( beta.EQ.zero )
THEN 27642 ELSE IF( beta.NE.one )
THEN 27644 c( i, j ) = beta*c( i, j )
27648 IF( ( a( j, l ).NE.zero ).OR.
27649 $ ( b( j, l ).NE.zero ) )
THEN 27650 temp1 = alpha*b( j, l )
27651 temp2 = alpha*a( j, l )
27653 c( i, j ) = c( i, j ) + a( i, l )*temp1 +
27670 temp1 = temp1 + a( l, i )*b( l, j )
27671 temp2 = temp2 + b( l, i )*a( l, j )
27673 IF( beta.EQ.zero )
THEN 27674 c( i, j ) = alpha*temp1 + alpha*temp2
27676 c( i, j ) = beta *c( i, j ) +
27677 $ alpha*temp1 + alpha*temp2
27687 temp1 = temp1 + a( l, i )*b( l, j )
27688 temp2 = temp2 + b( l, i )*a( l, j )
27690 IF( beta.EQ.zero )
THEN 27691 c( i, j ) = alpha*temp1 + alpha*temp2
27693 c( i, j ) = beta *c( i, j ) +
27694 $ alpha*temp1 + alpha*temp2
27706 SUBROUTINE zsyrk ( UPLO, TRANS, N, K, ALPHA, A, LDA,
27709 CHARACTER*1 UPLO, TRANS
27710 INTEGER N, K, LDA, LDC
27711 COMPLEX*16 ALPHA, BETA
27713 COMPLEX*16 A( lda, * ), C( ldc, * )
27831 INTEGER I, INFO, J, L, NROWA
27835 parameter( one = ( 1.0d+0, 0.0d+0 ) )
27837 parameter( zero = ( 0.0d+0, 0.0d+0 ) )
27843 IF( lsame( trans,
'N' ) )
THEN 27848 upper = lsame( uplo,
'U' )
27851 IF( ( .NOT.upper ).AND.
27852 $ ( .NOT.lsame( uplo ,
'L' ) ) )
THEN 27854 ELSE IF( ( .NOT.lsame( trans,
'N' ) ).AND.
27855 $ ( .NOT.lsame( trans,
'T' ) ) )
THEN 27857 ELSE IF( n .LT.0 )
THEN 27859 ELSE IF( k .LT.0 )
THEN 27861 ELSE IF( lda.LT.max( 1, nrowa ) )
THEN 27863 ELSE IF( ldc.LT.max( 1, n ) )
THEN 27866 IF( info.NE.0 )
THEN 27867 CALL xerbla(
'ZSYRK ', info )
27874 $ ( ( ( alpha.EQ.zero ).OR.( k.EQ.0 ) ).AND.( beta.EQ.one ) ) )
27879 IF( alpha.EQ.zero )
THEN 27881 IF( beta.EQ.zero )
THEN 27890 c( i, j ) = beta*c( i, j )
27895 IF( beta.EQ.zero )
THEN 27904 c( i, j ) = beta*c( i, j )
27914 IF( lsame( trans,
'N' ) )
THEN 27920 IF( beta.EQ.zero )
THEN 27924 ELSE IF( beta.NE.one )
THEN 27926 c( i, j ) = beta*c( i, j )
27930 IF( a( j, l ).NE.zero )
THEN 27931 temp = alpha*a( j, l )
27933 c( i, j ) = c( i, j ) + temp*a( i, l )
27940 IF( beta.EQ.zero )
THEN 27944 ELSE IF( beta.NE.one )
THEN 27946 c( i, j ) = beta*c( i, j )
27950 IF( a( j, l ).NE.zero )
THEN 27951 temp = alpha*a( j, l )
27953 c( i, j ) = c( i, j ) + temp*a( i, l )
27968 temp = temp + a( l, i )*a( l, j )
27970 IF( beta.EQ.zero )
THEN 27971 c( i, j ) = alpha*temp
27973 c( i, j ) = alpha*temp + beta*c( i, j )
27982 temp = temp + a( l, i )*a( l, j )
27984 IF( beta.EQ.zero )
THEN 27985 c( i, j ) = alpha*temp
27987 c( i, j ) = alpha*temp + beta*c( i, j )
27999 SUBROUTINE ztbmv ( UPLO, TRANS, DIAG, N, K, A, LDA, X, INCX )
28001 INTEGER INCX, K, LDA, N
28002 CHARACTER*1 DIAG, TRANS, UPLO
28004 COMPLEX*16 A( lda, * ), X( * )
28137 parameter( zero = ( 0.0d+0, 0.0d+0 ) )
28140 INTEGER I, INFO, IX, J, JX, KPLUS1, KX, L
28141 LOGICAL NOCONJ, NOUNIT
28148 INTRINSIC dconjg, max, min
28155 IF ( .NOT.lsame( uplo ,
'U' ).AND.
28156 $ .NOT.lsame( uplo ,
'L' ) )
THEN 28158 ELSE IF( .NOT.lsame( trans,
'N' ).AND.
28159 $ .NOT.lsame( trans,
'T' ).AND.
28160 $ .NOT.lsame( trans,
'C' ) )
THEN 28162 ELSE IF( .NOT.lsame( diag ,
'U' ).AND.
28163 $ .NOT.lsame( diag ,
'N' ) )
THEN 28165 ELSE IF( n.LT.0 )
THEN 28167 ELSE IF( k.LT.0 )
THEN 28169 ELSE IF( lda.LT.( k + 1 ) )
THEN 28171 ELSE IF( incx.EQ.0 )
THEN 28174 IF( info.NE.0 )
THEN 28175 CALL xerbla(
'ZTBMV ', info )
28184 noconj = lsame( trans,
'T' )
28185 nounit = lsame( diag ,
'N' )
28190 IF( incx.LE.0 )
THEN 28191 kx = 1 - ( n - 1 )*incx
28192 ELSE IF( incx.NE.1 )
THEN 28199 IF( lsame( trans,
'N' ) )
THEN 28203 IF( lsame( uplo,
'U' ) )
THEN 28205 IF( incx.EQ.1 )
THEN 28207 IF( x( j ).NE.zero )
THEN 28210 DO 10, i = max( 1, j - k ), j - 1
28211 x( i ) = x( i ) + temp*a( l + i, j )
28214 $ x( j ) = x( j )*a( kplus1, j )
28220 IF( x( jx ).NE.zero )
THEN 28224 DO 30, i = max( 1, j - k ), j - 1
28225 x( ix ) = x( ix ) + temp*a( l + i, j )
28229 $ x( jx ) = x( jx )*a( kplus1, j )
28237 IF( incx.EQ.1 )
THEN 28238 DO 60, j = n, 1, -1
28239 IF( x( j ).NE.zero )
THEN 28242 DO 50, i = min( n, j + k ), j + 1, -1
28243 x( i ) = x( i ) + temp*a( l + i, j )
28246 $ x( j ) = x( j )*a( 1, j )
28250 kx = kx + ( n - 1 )*incx
28252 DO 80, j = n, 1, -1
28253 IF( x( jx ).NE.zero )
THEN 28257 DO 70, i = min( n, j + k ), j + 1, -1
28258 x( ix ) = x( ix ) + temp*a( l + i, j )
28262 $ x( jx ) = x( jx )*a( 1, j )
28265 IF( ( n - j ).GE.k )
28274 IF( lsame( uplo,
'U' ) )
THEN 28276 IF( incx.EQ.1 )
THEN 28277 DO 110, j = n, 1, -1
28282 $ temp = temp*a( kplus1, j )
28283 DO 90, i = j - 1, max( 1, j - k ), -1
28284 temp = temp + a( l + i, j )*x( i )
28288 $ temp = temp*dconjg( a( kplus1, j ) )
28289 DO 100, i = j - 1, max( 1, j - k ), -1
28290 temp = temp + dconjg( a( l + i, j ) )*x( i )
28296 kx = kx + ( n - 1 )*incx
28298 DO 140, j = n, 1, -1
28305 $ temp = temp*a( kplus1, j )
28306 DO 120, i = j - 1, max( 1, j - k ), -1
28307 temp = temp + a( l + i, j )*x( ix )
28312 $ temp = temp*dconjg( a( kplus1, j ) )
28313 DO 130, i = j - 1, max( 1, j - k ), -1
28314 temp = temp + dconjg( a( l + i, j ) )*x( ix )
28323 IF( incx.EQ.1 )
THEN 28329 $ temp = temp*a( 1, j )
28330 DO 150, i = j + 1, min( n, j + k )
28331 temp = temp + a( l + i, j )*x( i )
28335 $ temp = temp*dconjg( a( 1, j ) )
28336 DO 160, i = j + 1, min( n, j + k )
28337 temp = temp + dconjg( a( l + i, j ) )*x( i )
28351 $ temp = temp*a( 1, j )
28352 DO 180, i = j + 1, min( n, j + k )
28353 temp = temp + a( l + i, j )*x( ix )
28358 $ temp = temp*dconjg( a( 1, j ) )
28359 DO 190, i = j + 1, min( n, j + k )
28360 temp = temp + dconjg( a( l + i, j ) )*x( ix )
28376 SUBROUTINE ztbsv ( UPLO, TRANS, DIAG, N, K, A, LDA, X, INCX )
28378 INTEGER INCX, K, LDA, N
28379 CHARACTER*1 DIAG, TRANS, UPLO
28381 COMPLEX*16 A( lda, * ), X( * )
28518 parameter( zero = ( 0.0d+0, 0.0d+0 ) )
28521 INTEGER I, INFO, IX, J, JX, KPLUS1, KX, L
28522 LOGICAL NOCONJ, NOUNIT
28529 INTRINSIC dconjg, max, min
28536 IF ( .NOT.lsame( uplo ,
'U' ).AND.
28537 $ .NOT.lsame( uplo ,
'L' ) )
THEN 28539 ELSE IF( .NOT.lsame( trans,
'N' ).AND.
28540 $ .NOT.lsame( trans,
'T' ).AND.
28541 $ .NOT.lsame( trans,
'C' ) )
THEN 28543 ELSE IF( .NOT.lsame( diag ,
'U' ).AND.
28544 $ .NOT.lsame( diag ,
'N' ) )
THEN 28546 ELSE IF( n.LT.0 )
THEN 28548 ELSE IF( k.LT.0 )
THEN 28550 ELSE IF( lda.LT.( k + 1 ) )
THEN 28552 ELSE IF( incx.EQ.0 )
THEN 28555 IF( info.NE.0 )
THEN 28556 CALL xerbla(
'ZTBSV ', info )
28565 noconj = lsame( trans,
'T' )
28566 nounit = lsame( diag ,
'N' )
28571 IF( incx.LE.0 )
THEN 28572 kx = 1 - ( n - 1 )*incx
28573 ELSE IF( incx.NE.1 )
THEN 28580 IF( lsame( trans,
'N' ) )
THEN 28584 IF( lsame( uplo,
'U' ) )
THEN 28586 IF( incx.EQ.1 )
THEN 28587 DO 20, j = n, 1, -1
28588 IF( x( j ).NE.zero )
THEN 28591 $ x( j ) = x( j )/a( kplus1, j )
28593 DO 10, i = j - 1, max( 1, j - k ), -1
28594 x( i ) = x( i ) - temp*a( l + i, j )
28599 kx = kx + ( n - 1 )*incx
28601 DO 40, j = n, 1, -1
28603 IF( x( jx ).NE.zero )
THEN 28607 $ x( jx ) = x( jx )/a( kplus1, j )
28609 DO 30, i = j - 1, max( 1, j - k ), -1
28610 x( ix ) = x( ix ) - temp*a( l + i, j )
28618 IF( incx.EQ.1 )
THEN 28620 IF( x( j ).NE.zero )
THEN 28623 $ x( j ) = x( j )/a( 1, j )
28625 DO 50, i = j + 1, min( n, j + k )
28626 x( i ) = x( i ) - temp*a( l + i, j )
28634 IF( x( jx ).NE.zero )
THEN 28638 $ x( jx ) = x( jx )/a( 1, j )
28640 DO 70, i = j + 1, min( n, j + k )
28641 x( ix ) = x( ix ) - temp*a( l + i, j )
28653 IF( lsame( uplo,
'U' ) )
THEN 28655 IF( incx.EQ.1 )
THEN 28660 DO 90, i = max( 1, j - k ), j - 1
28661 temp = temp - a( l + i, j )*x( i )
28664 $ temp = temp/a( kplus1, j )
28666 DO 100, i = max( 1, j - k ), j - 1
28667 temp = temp - dconjg( a( l + i, j ) )*x( i )
28670 $ temp = temp/dconjg( a( kplus1, j ) )
28681 DO 120, i = max( 1, j - k ), j - 1
28682 temp = temp - a( l + i, j )*x( ix )
28686 $ temp = temp/a( kplus1, j )
28688 DO 130, i = max( 1, j - k ), j - 1
28689 temp = temp - dconjg( a( l + i, j ) )*x( ix )
28693 $ temp = temp/dconjg( a( kplus1, j ) )
28702 IF( incx.EQ.1 )
THEN 28703 DO 170, j = n, 1, -1
28707 DO 150, i = min( n, j + k ), j + 1, -1
28708 temp = temp - a( l + i, j )*x( i )
28711 $ temp = temp/a( 1, j )
28713 DO 160, i = min( n, j + k ), j + 1, -1
28714 temp = temp - dconjg( a( l + i, j ) )*x( i )
28717 $ temp = temp/dconjg( a( 1, j ) )
28722 kx = kx + ( n - 1 )*incx
28724 DO 200, j = n, 1, -1
28729 DO 180, i = min( n, j + k ), j + 1, -1
28730 temp = temp - a( l + i, j )*x( ix )
28734 $ temp = temp/a( 1, j )
28736 DO 190, i = min( n, j + k ), j + 1, -1
28737 temp = temp - dconjg( a( l + i, j ) )*x( ix )
28741 $ temp = temp/dconjg( a( 1, j ) )
28745 IF( ( n - j ).GE.k )
28757 SUBROUTINE ztpmv ( UPLO, TRANS, DIAG, N, AP, X, INCX )
28760 CHARACTER*1 DIAG, TRANS, UPLO
28762 COMPLEX*16 AP( * ), X( * )
28855 parameter( zero = ( 0.0d+0, 0.0d+0 ) )
28858 INTEGER I, INFO, IX, J, JX, K, KK, KX
28859 LOGICAL NOCONJ, NOUNIT
28873 IF ( .NOT.lsame( uplo ,
'U' ).AND.
28874 $ .NOT.lsame( uplo ,
'L' ) )
THEN 28876 ELSE IF( .NOT.lsame( trans,
'N' ).AND.
28877 $ .NOT.lsame( trans,
'T' ).AND.
28878 $ .NOT.lsame( trans,
'C' ) )
THEN 28880 ELSE IF( .NOT.lsame( diag ,
'U' ).AND.
28881 $ .NOT.lsame( diag ,
'N' ) )
THEN 28883 ELSE IF( n.LT.0 )
THEN 28885 ELSE IF( incx.EQ.0 )
THEN 28888 IF( info.NE.0 )
THEN 28889 CALL xerbla(
'ZTPMV ', info )
28898 noconj = lsame( trans,
'T' )
28899 nounit = lsame( diag ,
'N' )
28904 IF( incx.LE.0 )
THEN 28905 kx = 1 - ( n - 1 )*incx
28906 ELSE IF( incx.NE.1 )
THEN 28913 IF( lsame( trans,
'N' ) )
THEN 28917 IF( lsame( uplo,
'U' ) )
THEN 28919 IF( incx.EQ.1 )
THEN 28921 IF( x( j ).NE.zero )
THEN 28924 DO 10, i = 1, j - 1
28925 x( i ) = x( i ) + temp*ap( k )
28929 $ x( j ) = x( j )*ap( kk + j - 1 )
28936 IF( x( jx ).NE.zero )
THEN 28939 DO 30, k = kk, kk + j - 2
28940 x( ix ) = x( ix ) + temp*ap( k )
28944 $ x( jx ) = x( jx )*ap( kk + j - 1 )
28951 kk = ( n*( n + 1 ) )/2
28952 IF( incx.EQ.1 )
THEN 28953 DO 60, j = n, 1, -1
28954 IF( x( j ).NE.zero )
THEN 28957 DO 50, i = n, j + 1, -1
28958 x( i ) = x( i ) + temp*ap( k )
28962 $ x( j ) = x( j )*ap( kk - n + j )
28964 kk = kk - ( n - j + 1 )
28967 kx = kx + ( n - 1 )*incx
28969 DO 80, j = n, 1, -1
28970 IF( x( jx ).NE.zero )
THEN 28973 DO 70, k = kk, kk - ( n - ( j + 1 ) ), -1
28974 x( ix ) = x( ix ) + temp*ap( k )
28978 $ x( jx ) = x( jx )*ap( kk - n + j )
28981 kk = kk - ( n - j + 1 )
28989 IF( lsame( uplo,
'U' ) )
THEN 28990 kk = ( n*( n + 1 ) )/2
28991 IF( incx.EQ.1 )
THEN 28992 DO 110, j = n, 1, -1
28997 $ temp = temp*ap( kk )
28998 DO 90, i = j - 1, 1, -1
28999 temp = temp + ap( k )*x( i )
29004 $ temp = temp*dconjg( ap( kk ) )
29005 DO 100, i = j - 1, 1, -1
29006 temp = temp + dconjg( ap( k ) )*x( i )
29014 jx = kx + ( n - 1 )*incx
29015 DO 140, j = n, 1, -1
29020 $ temp = temp*ap( kk )
29021 DO 120, k = kk - 1, kk - j + 1, -1
29023 temp = temp + ap( k )*x( ix )
29027 $ temp = temp*dconjg( ap( kk ) )
29028 DO 130, k = kk - 1, kk - j + 1, -1
29030 temp = temp + dconjg( ap( k ) )*x( ix )
29040 IF( incx.EQ.1 )
THEN 29046 $ temp = temp*ap( kk )
29047 DO 150, i = j + 1, n
29048 temp = temp + ap( k )*x( i )
29053 $ temp = temp*dconjg( ap( kk ) )
29054 DO 160, i = j + 1, n
29055 temp = temp + dconjg( ap( k ) )*x( i )
29060 kk = kk + ( n - j + 1 )
29069 $ temp = temp*ap( kk )
29070 DO 180, k = kk + 1, kk + n - j
29072 temp = temp + ap( k )*x( ix )
29076 $ temp = temp*dconjg( ap( kk ) )
29077 DO 190, k = kk + 1, kk + n - j
29079 temp = temp + dconjg( ap( k ) )*x( ix )
29084 kk = kk + ( n - j + 1 )
29095 SUBROUTINE ztpsv ( UPLO, TRANS, DIAG, N, AP, X, INCX )
29098 CHARACTER*1 DIAG, TRANS, UPLO
29100 COMPLEX*16 AP( * ), X( * )
29196 parameter( zero = ( 0.0d+0, 0.0d+0 ) )
29199 INTEGER I, INFO, IX, J, JX, K, KK, KX
29200 LOGICAL NOCONJ, NOUNIT
29214 IF ( .NOT.lsame( uplo ,
'U' ).AND.
29215 $ .NOT.lsame( uplo ,
'L' ) )
THEN 29217 ELSE IF( .NOT.lsame( trans,
'N' ).AND.
29218 $ .NOT.lsame( trans,
'T' ).AND.
29219 $ .NOT.lsame( trans,
'C' ) )
THEN 29221 ELSE IF( .NOT.lsame( diag ,
'U' ).AND.
29222 $ .NOT.lsame( diag ,
'N' ) )
THEN 29224 ELSE IF( n.LT.0 )
THEN 29226 ELSE IF( incx.EQ.0 )
THEN 29229 IF( info.NE.0 )
THEN 29230 CALL xerbla(
'ZTPSV ', info )
29239 noconj = lsame( trans,
'T' )
29240 nounit = lsame( diag ,
'N' )
29245 IF( incx.LE.0 )
THEN 29246 kx = 1 - ( n - 1 )*incx
29247 ELSE IF( incx.NE.1 )
THEN 29254 IF( lsame( trans,
'N' ) )
THEN 29258 IF( lsame( uplo,
'U' ) )
THEN 29259 kk = ( n*( n + 1 ) )/2
29260 IF( incx.EQ.1 )
THEN 29261 DO 20, j = n, 1, -1
29262 IF( x( j ).NE.zero )
THEN 29264 $ x( j ) = x( j )/ap( kk )
29267 DO 10, i = j - 1, 1, -1
29268 x( i ) = x( i ) - temp*ap( k )
29275 jx = kx + ( n - 1 )*incx
29276 DO 40, j = n, 1, -1
29277 IF( x( jx ).NE.zero )
THEN 29279 $ x( jx ) = x( jx )/ap( kk )
29282 DO 30, k = kk - 1, kk - j + 1, -1
29284 x( ix ) = x( ix ) - temp*ap( k )
29293 IF( incx.EQ.1 )
THEN 29295 IF( x( j ).NE.zero )
THEN 29297 $ x( j ) = x( j )/ap( kk )
29300 DO 50, i = j + 1, n
29301 x( i ) = x( i ) - temp*ap( k )
29305 kk = kk + ( n - j + 1 )
29310 IF( x( jx ).NE.zero )
THEN 29312 $ x( jx ) = x( jx )/ap( kk )
29315 DO 70, k = kk + 1, kk + n - j
29317 x( ix ) = x( ix ) - temp*ap( k )
29321 kk = kk + ( n - j + 1 )
29329 IF( lsame( uplo,
'U' ) )
THEN 29331 IF( incx.EQ.1 )
THEN 29336 DO 90, i = 1, j - 1
29337 temp = temp - ap( k )*x( i )
29341 $ temp = temp/ap( kk + j - 1 )
29343 DO 100, i = 1, j - 1
29344 temp = temp - dconjg( ap( k ) )*x( i )
29348 $ temp = temp/dconjg( ap( kk + j - 1 ) )
29359 DO 120, k = kk, kk + j - 2
29360 temp = temp - ap( k )*x( ix )
29364 $ temp = temp/ap( kk + j - 1 )
29366 DO 130, k = kk, kk + j - 2
29367 temp = temp - dconjg( ap( k ) )*x( ix )
29371 $ temp = temp/dconjg( ap( kk + j - 1 ) )
29379 kk = ( n*( n + 1 ) )/2
29380 IF( incx.EQ.1 )
THEN 29381 DO 170, j = n, 1, -1
29385 DO 150, i = n, j + 1, -1
29386 temp = temp - ap( k )*x( i )
29390 $ temp = temp/ap( kk - n + j )
29392 DO 160, i = n, j + 1, -1
29393 temp = temp - dconjg( ap( k ) )*x( i )
29397 $ temp = temp/dconjg( ap( kk - n + j ) )
29400 kk = kk - ( n - j + 1 )
29403 kx = kx + ( n - 1 )*incx
29405 DO 200, j = n, 1, -1
29409 DO 180, k = kk, kk - ( n - ( j + 1 ) ), -1
29410 temp = temp - ap( k )*x( ix )
29414 $ temp = temp/ap( kk - n + j )
29416 DO 190, k = kk, kk - ( n - ( j + 1 ) ), -1
29417 temp = temp - dconjg( ap( k ) )*x( ix )
29421 $ temp = temp/dconjg( ap( kk - n + j ) )
29425 kk = kk - ( n - j + 1 )
29436 SUBROUTINE ztrmm ( SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA,
29439 CHARACTER*1 SIDE, UPLO, TRANSA, DIAG
29440 INTEGER M, N, LDA, LDB
29443 COMPLEX*16 A( lda, * ), B( ldb, * )
29568 INTRINSIC dconjg, max
29570 LOGICAL LSIDE, NOCONJ, NOUNIT, UPPER
29571 INTEGER I, INFO, J, K, NROWA
29575 parameter( one = ( 1.0d+0, 0.0d+0 ) )
29577 parameter( zero = ( 0.0d+0, 0.0d+0 ) )
29583 lside = lsame( side ,
'L' )
29589 noconj = lsame( transa,
'T' )
29590 nounit = lsame( diag ,
'N' )
29591 upper = lsame( uplo ,
'U' )
29594 IF( ( .NOT.lside ).AND.
29595 $ ( .NOT.lsame( side ,
'R' ) ) )
THEN 29597 ELSE IF( ( .NOT.upper ).AND.
29598 $ ( .NOT.lsame( uplo ,
'L' ) ) )
THEN 29600 ELSE IF( ( .NOT.lsame( transa,
'N' ) ).AND.
29601 $ ( .NOT.lsame( transa,
'T' ) ).AND.
29602 $ ( .NOT.lsame( transa,
'C' ) ) )
THEN 29604 ELSE IF( ( .NOT.lsame( diag ,
'U' ) ).AND.
29605 $ ( .NOT.lsame( diag ,
'N' ) ) )
THEN 29607 ELSE IF( m .LT.0 )
THEN 29609 ELSE IF( n .LT.0 )
THEN 29611 ELSE IF( lda.LT.max( 1, nrowa ) )
THEN 29613 ELSE IF( ldb.LT.max( 1, m ) )
THEN 29616 IF( info.NE.0 )
THEN 29617 CALL xerbla(
'ZTRMM ', info )
29628 IF( alpha.EQ.zero )
THEN 29640 IF( lsame( transa,
'N' ) )
THEN 29647 IF( b( k, j ).NE.zero )
THEN 29648 temp = alpha*b( k, j )
29649 DO 30, i = 1, k - 1
29650 b( i, j ) = b( i, j ) + temp*a( i, k )
29653 $ temp = temp*a( k, k )
29661 IF( b( k, j ).NE.zero )
THEN 29662 temp = alpha*b( k, j )
29665 $ b( k, j ) = b( k, j )*a( k, k )
29666 DO 60, i = k + 1, m
29667 b( i, j ) = b( i, j ) + temp*a( i, k )
29679 DO 110, i = m, 1, -1
29683 $ temp = temp*a( i, i )
29684 DO 90, k = 1, i - 1
29685 temp = temp + a( k, i )*b( k, j )
29689 $ temp = temp*dconjg( a( i, i ) )
29690 DO 100, k = 1, i - 1
29691 temp = temp + dconjg( a( k, i ) )*b( k, j )
29694 b( i, j ) = alpha*temp
29703 $ temp = temp*a( i, i )
29704 DO 130, k = i + 1, m
29705 temp = temp + a( k, i )*b( k, j )
29709 $ temp = temp*dconjg( a( i, i ) )
29710 DO 140, k = i + 1, m
29711 temp = temp + dconjg( a( k, i ) )*b( k, j )
29714 b( i, j ) = alpha*temp
29720 IF( lsame( transa,
'N' ) )
THEN 29725 DO 200, j = n, 1, -1
29728 $ temp = temp*a( j, j )
29730 b( i, j ) = temp*b( i, j )
29732 DO 190, k = 1, j - 1
29733 IF( a( k, j ).NE.zero )
THEN 29734 temp = alpha*a( k, j )
29736 b( i, j ) = b( i, j ) + temp*b( i, k )
29745 $ temp = temp*a( j, j )
29747 b( i, j ) = temp*b( i, j )
29749 DO 230, k = j + 1, n
29750 IF( a( k, j ).NE.zero )
THEN 29751 temp = alpha*a( k, j )
29753 b( i, j ) = b( i, j ) + temp*b( i, k )
29765 DO 260, j = 1, k - 1
29766 IF( a( j, k ).NE.zero )
THEN 29768 temp = alpha*a( j, k )
29770 temp = alpha*dconjg( a( j, k ) )
29773 b( i, j ) = b( i, j ) + temp*b( i, k )
29780 temp = temp*a( k, k )
29782 temp = temp*dconjg( a( k, k ) )
29785 IF( temp.NE.one )
THEN 29787 b( i, k ) = temp*b( i, k )
29792 DO 320, k = n, 1, -1
29793 DO 300, j = k + 1, n
29794 IF( a( j, k ).NE.zero )
THEN 29796 temp = alpha*a( j, k )
29798 temp = alpha*dconjg( a( j, k ) )
29801 b( i, j ) = b( i, j ) + temp*b( i, k )
29808 temp = temp*a( k, k )
29810 temp = temp*dconjg( a( k, k ) )
29813 IF( temp.NE.one )
THEN 29815 b( i, k ) = temp*b( i, k )
29828 SUBROUTINE ztrmv ( UPLO, TRANS, DIAG, N, A, LDA, X, INCX )
29830 INTEGER INCX, LDA, N
29831 CHARACTER*1 DIAG, TRANS, UPLO
29833 COMPLEX*16 A( lda, * ), X( * )
29929 parameter( zero = ( 0.0d+0, 0.0d+0 ) )
29932 INTEGER I, INFO, IX, J, JX, KX
29933 LOGICAL NOCONJ, NOUNIT
29940 INTRINSIC dconjg, max
29947 IF ( .NOT.lsame( uplo ,
'U' ).AND.
29948 $ .NOT.lsame( uplo ,
'L' ) )
THEN 29950 ELSE IF( .NOT.lsame( trans,
'N' ).AND.
29951 $ .NOT.lsame( trans,
'T' ).AND.
29952 $ .NOT.lsame( trans,
'C' ) )
THEN 29954 ELSE IF( .NOT.lsame( diag ,
'U' ).AND.
29955 $ .NOT.lsame( diag ,
'N' ) )
THEN 29957 ELSE IF( n.LT.0 )
THEN 29959 ELSE IF( lda.LT.max( 1, n ) )
THEN 29961 ELSE IF( incx.EQ.0 )
THEN 29964 IF( info.NE.0 )
THEN 29965 CALL xerbla(
'ZTRMV ', info )
29974 noconj = lsame( trans,
'T' )
29975 nounit = lsame( diag ,
'N' )
29980 IF( incx.LE.0 )
THEN 29981 kx = 1 - ( n - 1 )*incx
29982 ELSE IF( incx.NE.1 )
THEN 29989 IF( lsame( trans,
'N' ) )
THEN 29993 IF( lsame( uplo,
'U' ) )
THEN 29994 IF( incx.EQ.1 )
THEN 29996 IF( x( j ).NE.zero )
THEN 29998 DO 10, i = 1, j - 1
29999 x( i ) = x( i ) + temp*a( i, j )
30002 $ x( j ) = x( j )*a( j, j )
30008 IF( x( jx ).NE.zero )
THEN 30011 DO 30, i = 1, j - 1
30012 x( ix ) = x( ix ) + temp*a( i, j )
30016 $ x( jx ) = x( jx )*a( j, j )
30022 IF( incx.EQ.1 )
THEN 30023 DO 60, j = n, 1, -1
30024 IF( x( j ).NE.zero )
THEN 30026 DO 50, i = n, j + 1, -1
30027 x( i ) = x( i ) + temp*a( i, j )
30030 $ x( j ) = x( j )*a( j, j )
30034 kx = kx + ( n - 1 )*incx
30036 DO 80, j = n, 1, -1
30037 IF( x( jx ).NE.zero )
THEN 30040 DO 70, i = n, j + 1, -1
30041 x( ix ) = x( ix ) + temp*a( i, j )
30045 $ x( jx ) = x( jx )*a( j, j )
30055 IF( lsame( uplo,
'U' ) )
THEN 30056 IF( incx.EQ.1 )
THEN 30057 DO 110, j = n, 1, -1
30061 $ temp = temp*a( j, j )
30062 DO 90, i = j - 1, 1, -1
30063 temp = temp + a( i, j )*x( i )
30067 $ temp = temp*dconjg( a( j, j ) )
30068 DO 100, i = j - 1, 1, -1
30069 temp = temp + dconjg( a( i, j ) )*x( i )
30075 jx = kx + ( n - 1 )*incx
30076 DO 140, j = n, 1, -1
30081 $ temp = temp*a( j, j )
30082 DO 120, i = j - 1, 1, -1
30084 temp = temp + a( i, j )*x( ix )
30088 $ temp = temp*dconjg( a( j, j ) )
30089 DO 130, i = j - 1, 1, -1
30091 temp = temp + dconjg( a( i, j ) )*x( ix )
30099 IF( incx.EQ.1 )
THEN 30104 $ temp = temp*a( j, j )
30105 DO 150, i = j + 1, n
30106 temp = temp + a( i, j )*x( i )
30110 $ temp = temp*dconjg( a( j, j ) )
30111 DO 160, i = j + 1, n
30112 temp = temp + dconjg( a( i, j ) )*x( i )
30124 $ temp = temp*a( j, j )
30125 DO 180, i = j + 1, n
30127 temp = temp + a( i, j )*x( ix )
30131 $ temp = temp*dconjg( a( j, j ) )
30132 DO 190, i = j + 1, n
30134 temp = temp + dconjg( a( i, j ) )*x( ix )
30149 SUBROUTINE ztrsm ( SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA,
30152 CHARACTER*1 SIDE, UPLO, TRANSA, DIAG
30153 INTEGER M, N, LDA, LDB
30156 COMPLEX*16 A( lda, * ), B( ldb, * )
30283 INTRINSIC dconjg, max
30285 LOGICAL LSIDE, NOCONJ, NOUNIT, UPPER
30286 INTEGER I, INFO, J, K, NROWA
30290 parameter( one = ( 1.0d+0, 0.0d+0 ) )
30292 parameter( zero = ( 0.0d+0, 0.0d+0 ) )
30298 lside = lsame( side ,
'L' )
30304 noconj = lsame( transa,
'T' )
30305 nounit = lsame( diag ,
'N' )
30306 upper = lsame( uplo ,
'U' )
30309 IF( ( .NOT.lside ).AND.
30310 $ ( .NOT.lsame( side ,
'R' ) ) )
THEN 30312 ELSE IF( ( .NOT.upper ).AND.
30313 $ ( .NOT.lsame( uplo ,
'L' ) ) )
THEN 30315 ELSE IF( ( .NOT.lsame( transa,
'N' ) ).AND.
30316 $ ( .NOT.lsame( transa,
'T' ) ).AND.
30317 $ ( .NOT.lsame( transa,
'C' ) ) )
THEN 30319 ELSE IF( ( .NOT.lsame( diag ,
'U' ) ).AND.
30320 $ ( .NOT.lsame( diag ,
'N' ) ) )
THEN 30322 ELSE IF( m .LT.0 )
THEN 30324 ELSE IF( n .LT.0 )
THEN 30326 ELSE IF( lda.LT.max( 1, nrowa ) )
THEN 30328 ELSE IF( ldb.LT.max( 1, m ) )
THEN 30331 IF( info.NE.0 )
THEN 30332 CALL xerbla(
'ZTRSM ', info )
30343 IF( alpha.EQ.zero )
THEN 30355 IF( lsame( transa,
'N' ) )
THEN 30361 IF( alpha.NE.one )
THEN 30363 b( i, j ) = alpha*b( i, j )
30366 DO 50, k = m, 1, -1
30367 IF( b( k, j ).NE.zero )
THEN 30369 $ b( k, j ) = b( k, j )/a( k, k )
30370 DO 40, i = 1, k - 1
30371 b( i, j ) = b( i, j ) - b( k, j )*a( i, k )
30378 IF( alpha.NE.one )
THEN 30380 b( i, j ) = alpha*b( i, j )
30384 IF( b( k, j ).NE.zero )
THEN 30386 $ b( k, j ) = b( k, j )/a( k, k )
30387 DO 80, i = k + 1, m
30388 b( i, j ) = b( i, j ) - b( k, j )*a( i, k )
30402 temp = alpha*b( i, j )
30404 DO 110, k = 1, i - 1
30405 temp = temp - a( k, i )*b( k, j )
30408 $ temp = temp/a( i, i )
30410 DO 120, k = 1, i - 1
30411 temp = temp - dconjg( a( k, i ) )*b( k, j )
30414 $ temp = temp/dconjg( a( i, i ) )
30421 DO 170, i = m, 1, -1
30422 temp = alpha*b( i, j )
30424 DO 150, k = i + 1, m
30425 temp = temp - a( k, i )*b( k, j )
30428 $ temp = temp/a( i, i )
30430 DO 160, k = i + 1, m
30431 temp = temp - dconjg( a( k, i ) )*b( k, j )
30434 $ temp = temp/dconjg( a( i, i ) )
30442 IF( lsame( transa,
'N' ) )
THEN 30448 IF( alpha.NE.one )
THEN 30450 b( i, j ) = alpha*b( i, j )
30453 DO 210, k = 1, j - 1
30454 IF( a( k, j ).NE.zero )
THEN 30456 b( i, j ) = b( i, j ) - a( k, j )*b( i, k )
30461 temp = one/a( j, j )
30463 b( i, j ) = temp*b( i, j )
30468 DO 280, j = n, 1, -1
30469 IF( alpha.NE.one )
THEN 30471 b( i, j ) = alpha*b( i, j )
30474 DO 260, k = j + 1, n
30475 IF( a( k, j ).NE.zero )
THEN 30477 b( i, j ) = b( i, j ) - a( k, j )*b( i, k )
30482 temp = one/a( j, j )
30484 b( i, j ) = temp*b( i, j )
30495 DO 330, k = n, 1, -1
30498 temp = one/a( k, k )
30500 temp = one/dconjg( a( k, k ) )
30503 b( i, k ) = temp*b( i, k )
30506 DO 310, j = 1, k - 1
30507 IF( a( j, k ).NE.zero )
THEN 30511 temp = dconjg( a( j, k ) )
30514 b( i, j ) = b( i, j ) - temp*b( i, k )
30518 IF( alpha.NE.one )
THEN 30520 b( i, k ) = alpha*b( i, k )
30528 temp = one/a( k, k )
30530 temp = one/dconjg( a( k, k ) )
30533 b( i, k ) = temp*b( i, k )
30536 DO 360, j = k + 1, n
30537 IF( a( j, k ).NE.zero )
THEN 30541 temp = dconjg( a( j, k ) )
30544 b( i, j ) = b( i, j ) - temp*b( i, k )
30548 IF( alpha.NE.one )
THEN 30550 b( i, k ) = alpha*b( i, k )
30563 SUBROUTINE ztrsv ( UPLO, TRANS, DIAG, N, A, LDA, X, INCX )
30565 INTEGER INCX, LDA, N
30566 CHARACTER*1 DIAG, TRANS, UPLO
30568 COMPLEX*16 A( lda, * ), X( * )
30667 parameter( zero = ( 0.0d+0, 0.0d+0 ) )
30670 INTEGER I, INFO, IX, J, JX, KX
30671 LOGICAL NOCONJ, NOUNIT
30678 INTRINSIC dconjg, max
30685 IF ( .NOT.lsame( uplo ,
'U' ).AND.
30686 $ .NOT.lsame( uplo ,
'L' ) )
THEN 30688 ELSE IF( .NOT.lsame( trans,
'N' ).AND.
30689 $ .NOT.lsame( trans,
'T' ).AND.
30690 $ .NOT.lsame( trans,
'C' ) )
THEN 30692 ELSE IF( .NOT.lsame( diag ,
'U' ).AND.
30693 $ .NOT.lsame( diag ,
'N' ) )
THEN 30695 ELSE IF( n.LT.0 )
THEN 30697 ELSE IF( lda.LT.max( 1, n ) )
THEN 30699 ELSE IF( incx.EQ.0 )
THEN 30702 IF( info.NE.0 )
THEN 30703 CALL xerbla(
'ZTRSV ', info )
30712 noconj = lsame( trans,
'T' )
30713 nounit = lsame( diag ,
'N' )
30718 IF( incx.LE.0 )
THEN 30719 kx = 1 - ( n - 1 )*incx
30720 ELSE IF( incx.NE.1 )
THEN 30727 IF( lsame( trans,
'N' ) )
THEN 30731 IF( lsame( uplo,
'U' ) )
THEN 30732 IF( incx.EQ.1 )
THEN 30733 DO 20, j = n, 1, -1
30734 IF( x( j ).NE.zero )
THEN 30736 $ x( j ) = x( j )/a( j, j )
30738 DO 10, i = j - 1, 1, -1
30739 x( i ) = x( i ) - temp*a( i, j )
30744 jx = kx + ( n - 1 )*incx
30745 DO 40, j = n, 1, -1
30746 IF( x( jx ).NE.zero )
THEN 30748 $ x( jx ) = x( jx )/a( j, j )
30751 DO 30, i = j - 1, 1, -1
30753 x( ix ) = x( ix ) - temp*a( i, j )
30760 IF( incx.EQ.1 )
THEN 30762 IF( x( j ).NE.zero )
THEN 30764 $ x( j ) = x( j )/a( j, j )
30766 DO 50, i = j + 1, n
30767 x( i ) = x( i ) - temp*a( i, j )
30774 IF( x( jx ).NE.zero )
THEN 30776 $ x( jx ) = x( jx )/a( j, j )
30779 DO 70, i = j + 1, n
30781 x( ix ) = x( ix ) - temp*a( i, j )
30792 IF( lsame( uplo,
'U' ) )
THEN 30793 IF( incx.EQ.1 )
THEN 30797 DO 90, i = 1, j - 1
30798 temp = temp - a( i, j )*x( i )
30801 $ temp = temp/a( j, j )
30803 DO 100, i = 1, j - 1
30804 temp = temp - dconjg( a( i, j ) )*x( i )
30807 $ temp = temp/dconjg( a( j, j ) )
30817 DO 120, i = 1, j - 1
30818 temp = temp - a( i, j )*x( ix )
30822 $ temp = temp/a( j, j )
30824 DO 130, i = 1, j - 1
30825 temp = temp - dconjg( a( i, j ) )*x( ix )
30829 $ temp = temp/dconjg( a( j, j ) )
30836 IF( incx.EQ.1 )
THEN 30837 DO 170, j = n, 1, -1
30840 DO 150, i = n, j + 1, -1
30841 temp = temp - a( i, j )*x( i )
30844 $ temp = temp/a( j, j )
30846 DO 160, i = n, j + 1, -1
30847 temp = temp - dconjg( a( i, j ) )*x( i )
30850 $ temp = temp/dconjg( a( j, j ) )
30855 kx = kx + ( n - 1 )*incx
30857 DO 200, j = n, 1, -1
30861 DO 180, i = n, j + 1, -1
30862 temp = temp - a( i, j )*x( ix )
30866 $ temp = temp/a( j, j )
30868 DO 190, i = n, j + 1, -1
30869 temp = temp - dconjg( a( i, j ) )*x( ix )
30873 $ temp = temp/dconjg( a( j, j ) )
subroutine ztrsv(UPLO, TRANS, DIAG, N, A, LDA, X, INCX)
subroutine csrot(n, cx, incx, cy, incy, c, s)
complex function cdotc(n, cx, incx, cy, incy)
subroutine dtrmm(SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA, B, LDB)
subroutine zsyrk(UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, C, LDC)
subroutine chemm(SIDE, UPLO, M, N, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
subroutine zhemm(SIDE, UPLO, M, N, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
complex function cdotu(n, cx, incx, cy, incy)
double precision function dsdot(N, SX, INCX, SY, INCY)
subroutine ztrsm(SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA, B, LDB)
subroutine dtpmv(UPLO, TRANS, DIAG, N, AP, X, INCX)
subroutine sspr(UPLO, N, ALPHA, X, INCX, AP)
subroutine stpsv(UPLO, TRANS, DIAG, N, AP, X, INCX)
subroutine ctrmv(UPLO, TRANS, DIAG, N, A, LDA, X, INCX)
integer function izamax(n, zx, incx)
subroutine ctbsv(UPLO, TRANS, DIAG, N, K, A, LDA, X, INCX)
subroutine zhpr2(UPLO, N, ALPHA, X, INCX, Y, INCY, AP)
subroutine ztpsv(UPLO, TRANS, DIAG, N, AP, X, INCX)
subroutine dger(M, N, ALPHA, X, INCX, Y, INCY, A, LDA)
subroutine cscal(n, ca, cx, incx)
subroutine zcopy(n, zx, incx, zy, incy)
subroutine sgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
subroutine ctrsm(SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA, B, LDB)
subroutine ssbmv(UPLO, N, K, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
double precision function dznrm2(N, X, INCX)
subroutine sscal(n, sa, sx, incx)
subroutine ssyrk(UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, C, LDC)
subroutine drotmg(DD1, DD2, DX1, DY1, DPARAM)
double precision function dcabs1(z)
subroutine xerbla(SRNAME, INFO)
subroutine chpr(UPLO, N, ALPHA, X, INCX, AP)
subroutine chemv(UPLO, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
subroutine srotg(sa, sb, c, s)
subroutine zgbmv(TRANS, M, N, KL, KU, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
subroutine srot(n, sx, incx, sy, incy, c, s)
subroutine zhpr(UPLO, N, ALPHA, X, INCX, AP)
subroutine cher2k(UPLO, TRANS, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
double precision function dasum(n, dx, incx)
subroutine ztrmm(SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA, B, LDB)
real function sdot(n, sx, incx, sy, incy)
subroutine dspmv(UPLO, N, ALPHA, AP, X, INCX, BETA, Y, INCY)
subroutine scopy(n, sx, incx, sy, incy)
subroutine cgerc(M, N, ALPHA, X, INCX, Y, INCY, A, LDA)
subroutine csyrk(UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, C, LDC)
subroutine dcopy(n, dx, incx, dy, incy)
subroutine chpr2(UPLO, N, ALPHA, X, INCX, Y, INCY, AP)
subroutine zgeru(M, N, ALPHA, X, INCX, Y, INCY, A, LDA)
subroutine dtpsv(UPLO, TRANS, DIAG, N, AP, X, INCX)
subroutine cherk(UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, C, LDC)
subroutine zherk(UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, C, LDC)
subroutine dswap(n, dx, incx, dy, incy)
subroutine cgeru(M, N, ALPHA, X, INCX, Y, INCY, A, LDA)
subroutine chbmv(UPLO, N, K, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
subroutine sgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
subroutine sger(M, N, ALPHA, X, INCX, Y, INCY, A, LDA)
subroutine srotmg(SD1, SD2, SX1, SY1, SPARAM)
subroutine dsymm(SIDE, UPLO, M, N, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
subroutine zsymm(SIDE, UPLO, M, N, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
subroutine stpmv(UPLO, TRANS, DIAG, N, AP, X, INCX)
subroutine daxpy(n, da, dx, incx, dy, incy)
subroutine srotm(N, SX, INCX, SY, INCY, SPARAM)
subroutine ccopy(n, cx, incx, cy, incy)
subroutine zgerc(M, N, ALPHA, X, INCX, Y, INCY, A, LDA)
subroutine ztpmv(UPLO, TRANS, DIAG, N, AP, X, INCX)
subroutine zdscal(n, da, zx, incx)
double complex function zdotc(n, zx, incx, zy, incy)
subroutine ssymm(SIDE, UPLO, M, N, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
i double fun_3term fun_3term int n
subroutine drot(n, dx, incx, dy, incy, c, s)
subroutine dsyr2(UPLO, N, ALPHA, X, INCX, Y, INCY, A, LDA)
subroutine zsyr2k(UPLO, TRANS, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
real function scnrm2(N, X, INCX)
subroutine ztrmv(UPLO, TRANS, DIAG, N, A, LDA, X, INCX)
subroutine caxpy(n, ca, cx, incx, cy, incy)
subroutine ctbmv(UPLO, TRANS, DIAG, N, K, A, LDA, X, INCX)
subroutine crotg(ca, cb, c, s)
subroutine ctrmm(SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA, B, LDB)
subroutine dsbmv(UPLO, N, K, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
subroutine zher(UPLO, N, ALPHA, X, INCX, A, LDA)
subroutine ssymv(UPLO, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
subroutine cher2(UPLO, N, ALPHA, X, INCX, Y, INCY, A, LDA)
double complex function zdotu(n, zx, incx, zy, incy)
subroutine dgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
subroutine strsm(SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA, B, LDB)
subroutine ctpmv(UPLO, TRANS, DIAG, N, AP, X, INCX)
subroutine dscal(n, da, dx, incx)
subroutine ssyr2k(UPLO, TRANS, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
subroutine zaxpy(n, za, zx, incx, zy, incy)
subroutine dsymv(UPLO, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
subroutine dtrsm(SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA, B, LDB)
subroutine dtrmv(UPLO, TRANS, DIAG, N, A, LDA, X, INCX)
subroutine chpmv(UPLO, N, ALPHA, AP, X, INCX, BETA, Y, INCY)
subroutine csymm(SIDE, UPLO, M, N, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
double precision function dzasum(n, zx, incx)
subroutine cgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
subroutine zher2(UPLO, N, ALPHA, X, INCX, Y, INCY, A, LDA)
double precision function dnrm2(N, X, INCX)
subroutine dgbmv(TRANS, M, N, KL, KU, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
real function snrm2(N, X, INCX)
subroutine sswap(n, sx, incx, sy, incy)
logical function lsame(CA, CB)
subroutine dspr2(UPLO, N, ALPHA, X, INCX, Y, INCY, AP)
subroutine saxpy(n, sa, sx, incx, sy, incy)
subroutine zgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
subroutine zhbmv(UPLO, N, K, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
subroutine drotg(da, db, c, s)
subroutine dtbmv(UPLO, TRANS, DIAG, N, K, A, LDA, X, INCX)
subroutine ssyr(UPLO, N, ALPHA, X, INCX, A, LDA)
subroutine csscal(n, sa, cx, incx)
real function sdsdot(N, SB, SX, INCX, SY, INCY)
subroutine zswap(n, zx, incx, zy, incy)
subroutine zrotg(ca, cb, c, s)
subroutine drotm(N, DX, INCX, DY, INCY, DPARAM)
subroutine zgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
subroutine cgbmv(TRANS, M, N, KL, KU, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
subroutine ctpsv(UPLO, TRANS, DIAG, N, AP, X, INCX)
subroutine zhemv(UPLO, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
subroutine stbmv(UPLO, TRANS, DIAG, N, K, A, LDA, X, INCX)
double precision function ddot(n, dx, incx, dy, incy)
subroutine ztbmv(UPLO, TRANS, DIAG, N, K, A, LDA, X, INCX)
subroutine dsyrk(UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, C, LDC)
real function sasum(n, sx, incx)
subroutine zscal(n, za, zx, incx)
subroutine dspr(UPLO, N, ALPHA, X, INCX, AP)
subroutine ctrsv(UPLO, TRANS, DIAG, N, A, LDA, X, INCX)
subroutine zher2k(UPLO, TRANS, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
integer function idamax(n, dx, incx)
subroutine cswap(n, cx, incx, cy, incy)
subroutine zdrot(n, zx, incx, zy, incy, c, s)
subroutine cher(UPLO, N, ALPHA, X, INCX, A, LDA)
subroutine dtrsv(UPLO, TRANS, DIAG, N, A, LDA, X, INCX)
subroutine ssyr2(UPLO, N, ALPHA, X, INCX, Y, INCY, A, LDA)
subroutine dtbsv(UPLO, TRANS, DIAG, N, K, A, LDA, X, INCX)
subroutine zhpmv(UPLO, N, ALPHA, AP, X, INCX, BETA, Y, INCY)
subroutine strmm(SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA, B, LDB)
integer function icamax(n, cx, incx)
subroutine sgbmv(TRANS, M, N, KL, KU, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
subroutine dsyr(UPLO, N, ALPHA, X, INCX, A, LDA)
real function scasum(n, cx, incx)
subroutine dgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
subroutine strsv(UPLO, TRANS, DIAG, N, A, LDA, X, INCX)
subroutine sspr2(UPLO, N, ALPHA, X, INCX, Y, INCY, AP)
subroutine strmv(UPLO, TRANS, DIAG, N, A, LDA, X, INCX)
subroutine dsyr2k(UPLO, TRANS, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
subroutine ztbsv(UPLO, TRANS, DIAG, N, K, A, LDA, X, INCX)
integer function isamax(n, sx, incx)
subroutine sspmv(UPLO, N, ALPHA, AP, X, INCX, BETA, Y, INCY)
subroutine cgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
subroutine csyr2k(UPLO, TRANS, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
subroutine stbsv(UPLO, TRANS, DIAG, N, K, A, LDA, X, INCX)